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 "Delete view" -command delview -state disabled
364 .bar.view add separator
365 .bar.view add radiobutton -label "All files" -command {showview 0} \
366 -variable selectedview -value 0
368 .bar add cascade -label "Help" -menu .bar.help
369 .bar.help add command -label "About gitk" -command about
370 .bar.help add command -label "Key bindings" -command keys
371 .bar.help configure -font $uifont
372 . configure -menu .bar
374 if {![info exists geometry(canv1)]} {
375 set geometry(canv1) [expr {45 * $charspc}]
376 set geometry(canv2) [expr {30 * $charspc}]
377 set geometry(canv3) [expr {15 * $charspc}]
378 set geometry(canvh) [expr {25 * $linespc + 4}]
379 set geometry(ctextw) 80
380 set geometry(ctexth) 30
381 set geometry(cflistw) 30
383 panedwindow .ctop -orient vertical
384 if {[info exists geometry(width)]} {
385 .ctop conf -width $geometry(width) -height $geometry(height)
386 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
387 set geometry(ctexth) [expr {($texth - 8) /
388 [font metrics $textfont -linespace]}]
392 pack .ctop.top.bar -side bottom -fill x
393 set cscroll .ctop.top.csb
394 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
395 pack $cscroll -side right -fill y
396 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
397 pack .ctop.top.clist -side top -fill both -expand 1
399 set canv .ctop.top.clist.canv
400 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
402 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
403 .ctop.top.clist add $canv
404 set canv2 .ctop.top.clist.canv2
405 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
406 -bg white -bd 0 -yscrollincr $linespc
407 .ctop.top.clist add $canv2
408 set canv3 .ctop.top.clist.canv3
409 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
410 -bg white -bd 0 -yscrollincr $linespc
411 .ctop.top.clist add $canv3
412 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
414 set sha1entry .ctop.top.bar.sha1
415 set entries $sha1entry
416 set sha1but .ctop.top.bar.sha1label
417 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
418 -command gotocommit -width 8 -font $uifont
419 $sha1but conf -disabledforeground [$sha1but cget -foreground]
420 pack .ctop.top.bar.sha1label -side left
421 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
422 trace add variable sha1string write sha1change
423 pack $sha1entry -side left -pady 2
425 image create bitmap bm-left -data {
426 #define left_width 16
427 #define left_height 16
428 static unsigned char left_bits[] = {
429 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
430 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
431 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
433 image create bitmap bm-right -data {
434 #define right_width 16
435 #define right_height 16
436 static unsigned char right_bits[] = {
437 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
438 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
439 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
441 button .ctop.top.bar.leftbut -image bm-left -command goback \
442 -state disabled -width 26
443 pack .ctop.top.bar.leftbut -side left -fill y
444 button .ctop.top.bar.rightbut -image bm-right -command goforw \
445 -state disabled -width 26
446 pack .ctop.top.bar.rightbut -side left -fill y
448 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
449 pack .ctop.top.bar.findbut -side left
451 set fstring .ctop.top.bar.findstring
452 lappend entries $fstring
453 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
454 pack $fstring -side left -expand 1 -fill x
456 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
457 findtype Exact IgnCase Regexp]
458 .ctop.top.bar.findtype configure -font $uifont
459 .ctop.top.bar.findtype.menu configure -font $uifont
460 set findloc "All fields"
461 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
462 Comments Author Committer Files Pickaxe
463 .ctop.top.bar.findloc configure -font $uifont
464 .ctop.top.bar.findloc.menu configure -font $uifont
466 pack .ctop.top.bar.findloc -side right
467 pack .ctop.top.bar.findtype -side right
468 # for making sure type==Exact whenever loc==Pickaxe
469 trace add variable findloc write findlocchange
471 panedwindow .ctop.cdet -orient horizontal
473 frame .ctop.cdet.left
474 set ctext .ctop.cdet.left.ctext
475 text $ctext -bg white -state disabled -font $textfont \
476 -width $geometry(ctextw) -height $geometry(ctexth) \
477 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
478 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
479 pack .ctop.cdet.left.sb -side right -fill y
480 pack $ctext -side left -fill both -expand 1
481 .ctop.cdet add .ctop.cdet.left
483 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
484 $ctext tag conf hunksep -fore blue
485 $ctext tag conf d0 -fore red
486 $ctext tag conf d1 -fore "#00a000"
487 $ctext tag conf m0 -fore red
488 $ctext tag conf m1 -fore blue
489 $ctext tag conf m2 -fore green
490 $ctext tag conf m3 -fore purple
491 $ctext tag conf m4 -fore brown
492 $ctext tag conf m5 -fore "#009090"
493 $ctext tag conf m6 -fore magenta
494 $ctext tag conf m7 -fore "#808000"
495 $ctext tag conf m8 -fore "#009000"
496 $ctext tag conf m9 -fore "#ff0080"
497 $ctext tag conf m10 -fore cyan
498 $ctext tag conf m11 -fore "#b07070"
499 $ctext tag conf m12 -fore "#70b0f0"
500 $ctext tag conf m13 -fore "#70f0b0"
501 $ctext tag conf m14 -fore "#f0b070"
502 $ctext tag conf m15 -fore "#ff70b0"
503 $ctext tag conf mmax -fore darkgrey
505 $ctext tag conf mresult -font [concat $textfont bold]
506 $ctext tag conf msep -font [concat $textfont bold]
507 $ctext tag conf found -back yellow
509 frame .ctop.cdet.right
510 set cflist .ctop.cdet.right.cfiles
511 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
512 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
513 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
514 pack .ctop.cdet.right.sb -side right -fill y
515 pack $cflist -side left -fill both -expand 1
516 .ctop.cdet add .ctop.cdet.right
517 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
519 pack .ctop -side top -fill both -expand 1
521 bindall <1> {selcanvline %W %x %y}
522 #bindall <B1-Motion> {selcanvline %W %x %y}
523 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
524 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
525 bindall <2> "canvscan mark %W %x %y"
526 bindall <B2-Motion> "canvscan dragto %W %x %y"
527 bindkey <Home> selfirstline
528 bindkey <End> sellastline
529 bind . <Key-Up> "selnextline -1"
530 bind . <Key-Down> "selnextline 1"
531 bindkey <Key-Right> "goforw"
532 bindkey <Key-Left> "goback"
533 bind . <Key-Prior> "selnextpage -1"
534 bind . <Key-Next> "selnextpage 1"
535 bind . <Control-Home> "allcanvs yview moveto 0.0"
536 bind . <Control-End> "allcanvs yview moveto 1.0"
537 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
538 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
539 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
540 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
541 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
542 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
543 bindkey <Key-space> "$ctext yview scroll 1 pages"
544 bindkey p "selnextline -1"
545 bindkey n "selnextline 1"
548 bindkey i "selnextline -1"
549 bindkey k "selnextline 1"
552 bindkey b "$ctext yview scroll -1 pages"
553 bindkey d "$ctext yview scroll 18 units"
554 bindkey u "$ctext yview scroll -18 units"
555 bindkey / {findnext 1}
556 bindkey <Key-Return> {findnext 0}
559 bind . <Control-q> doquit
560 bind . <Control-f> dofind
561 bind . <Control-g> {findnext 0}
562 bind . <Control-r> findprev
563 bind . <Control-equal> {incrfont 1}
564 bind . <Control-KP_Add> {incrfont 1}
565 bind . <Control-minus> {incrfont -1}
566 bind . <Control-KP_Subtract> {incrfont -1}
567 bind $cflist <<ListboxSelect>> listboxsel
568 bind . <Destroy> {savestuff %W}
569 bind . <Button-1> "click %W"
570 bind $fstring <Key-Return> dofind
571 bind $sha1entry <Key-Return> gotocommit
572 bind $sha1entry <<PasteSelection>> clearsha1
574 set maincursor [. cget -cursor]
575 set textcursor [$ctext cget -cursor]
576 set curtextcursor $textcursor
578 set rowctxmenu .rowctxmenu
579 menu $rowctxmenu -tearoff 0
580 $rowctxmenu add command -label "Diff this -> selected" \
581 -command {diffvssel 0}
582 $rowctxmenu add command -label "Diff selected -> this" \
583 -command {diffvssel 1}
584 $rowctxmenu add command -label "Make patch" -command mkpatch
585 $rowctxmenu add command -label "Create tag" -command mktag
586 $rowctxmenu add command -label "Write commit to file" -command writecommit
589 # mouse-2 makes all windows scan vertically, but only the one
590 # the cursor is in scans horizontally
591 proc canvscan {op w x y} {
592 global canv canv2 canv3
593 foreach c [list $canv $canv2 $canv3] {
602 proc scrollcanv {cscroll f0 f1} {
607 # when we make a key binding for the toplevel, make sure
608 # it doesn't get triggered when that key is pressed in the
609 # find string entry widget.
610 proc bindkey {ev script} {
613 set escript [bind Entry $ev]
614 if {$escript == {}} {
615 set escript [bind Entry <Key>]
618 bind $e $ev "$escript; break"
622 # set the focus back to the toplevel for any click outside
633 global canv canv2 canv3 ctext cflist mainfont textfont uifont
634 global stuffsaved findmergefiles maxgraphpct
636 global viewname viewfiles viewperm nextviewnum
638 if {$stuffsaved} return
639 if {![winfo viewable .]} return
641 set f [open "~/.gitk-new" w]
642 puts $f [list set mainfont $mainfont]
643 puts $f [list set textfont $textfont]
644 puts $f [list set uifont $uifont]
645 puts $f [list set findmergefiles $findmergefiles]
646 puts $f [list set maxgraphpct $maxgraphpct]
647 puts $f [list set maxwidth $maxwidth]
648 puts $f "set geometry(width) [winfo width .ctop]"
649 puts $f "set geometry(height) [winfo height .ctop]"
650 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
651 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
652 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
653 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
654 set wid [expr {([winfo width $ctext] - 8) \
655 / [font measure $textfont "0"]}]
656 puts $f "set geometry(ctextw) $wid"
657 set wid [expr {([winfo width $cflist] - 11) \
658 / [font measure [$cflist cget -font] "0"]}]
659 puts $f "set geometry(cflistw) $wid"
660 puts -nonewline $f "set permviews {"
661 for {set v 0} {$v < $nextviewnum} {incr v} {
663 puts $f "{[list $viewname($v) $viewfiles($v)]}"
668 file rename -force "~/.gitk-new" "~/.gitk"
673 proc resizeclistpanes {win w} {
675 if {[info exists oldwidth($win)]} {
676 set s0 [$win sash coord 0]
677 set s1 [$win sash coord 1]
679 set sash0 [expr {int($w/2 - 2)}]
680 set sash1 [expr {int($w*5/6 - 2)}]
682 set factor [expr {1.0 * $w / $oldwidth($win)}]
683 set sash0 [expr {int($factor * [lindex $s0 0])}]
684 set sash1 [expr {int($factor * [lindex $s1 0])}]
688 if {$sash1 < $sash0 + 20} {
689 set sash1 [expr {$sash0 + 20}]
691 if {$sash1 > $w - 10} {
692 set sash1 [expr {$w - 10}]
693 if {$sash0 > $sash1 - 20} {
694 set sash0 [expr {$sash1 - 20}]
698 $win sash place 0 $sash0 [lindex $s0 1]
699 $win sash place 1 $sash1 [lindex $s1 1]
701 set oldwidth($win) $w
704 proc resizecdetpanes {win w} {
706 if {[info exists oldwidth($win)]} {
707 set s0 [$win sash coord 0]
709 set sash0 [expr {int($w*3/4 - 2)}]
711 set factor [expr {1.0 * $w / $oldwidth($win)}]
712 set sash0 [expr {int($factor * [lindex $s0 0])}]
716 if {$sash0 > $w - 15} {
717 set sash0 [expr {$w - 15}]
720 $win sash place 0 $sash0 [lindex $s0 1]
722 set oldwidth($win) $w
726 global canv canv2 canv3
732 proc bindall {event action} {
733 global canv canv2 canv3
734 bind $canv $event $action
735 bind $canv2 $event $action
736 bind $canv3 $event $action
741 if {[winfo exists $w]} {
746 wm title $w "About gitk"
748 Gitk - a commit viewer for git
750 Copyright © 2005-2006 Paul Mackerras
752 Use and redistribute under the terms of the GNU General Public License} \
753 -justify center -aspect 400
754 pack $w.m -side top -fill x -padx 20 -pady 20
755 button $w.ok -text Close -command "destroy $w"
756 pack $w.ok -side bottom
761 if {[winfo exists $w]} {
766 wm title $w "Gitk key bindings"
771 <Home> Move to first commit
772 <End> Move to last commit
773 <Up>, p, i Move up one commit
774 <Down>, n, k Move down one commit
775 <Left>, z, j Go back in history list
776 <Right>, x, l Go forward in history list
777 <PageUp> Move up one page in commit list
778 <PageDown> Move down one page in commit list
779 <Ctrl-Home> Scroll to top of commit list
780 <Ctrl-End> Scroll to bottom of commit list
781 <Ctrl-Up> Scroll commit list up one line
782 <Ctrl-Down> Scroll commit list down one line
783 <Ctrl-PageUp> Scroll commit list up one page
784 <Ctrl-PageDown> Scroll commit list down one page
785 <Delete>, b Scroll diff view up one page
786 <Backspace> Scroll diff view up one page
787 <Space> Scroll diff view down one page
788 u Scroll diff view up 18 lines
789 d Scroll diff view down 18 lines
791 <Ctrl-G> Move to next find hit
792 <Ctrl-R> Move to previous find hit
793 <Return> Move to next find hit
794 / Move to next find hit, or redo find
795 ? Move to previous find hit
796 f Scroll diff view to next file
797 <Ctrl-KP+> Increase font size
798 <Ctrl-plus> Increase font size
799 <Ctrl-KP-> Decrease font size
800 <Ctrl-minus> Decrease font size
802 -justify left -bg white -border 2 -relief sunken
803 pack $w.m -side top -fill both
804 button $w.ok -text Close -command "destroy $w"
805 pack $w.ok -side bottom
809 global newviewname nextviewnum newviewtop newviewperm uifont
812 if {[winfo exists $top]} {
818 wm title $top "Gitk view definition"
819 label $top.nl -text "Name" -font $uifont
820 entry $top.name -width 20 -textvariable newviewname
821 set newviewname "View $nextviewnum"
822 grid $top.nl $top.name -sticky w -pady 5
824 checkbutton $top.perm -text "Remember this view" -variable newviewperm
825 grid $top.perm - -pady 5 -sticky w
826 message $top.l -aspect 500 -font $uifont \
827 -text "Enter files and directories to include, one per line:"
828 grid $top.l - -sticky w
829 text $top.t -width 40 -height 10 -background white
830 grid $top.t - -sticky w -padx 5
832 button $top.buts.ok -text "OK" -command newviewok
833 button $top.buts.can -text "Cancel" -command newviewcan
834 grid $top.buts.ok $top.buts.can
835 grid columnconfigure $top.buts 0 -weight 1 -uniform a
836 grid columnconfigure $top.buts 1 -weight 1 -uniform a
837 grid $top.buts - -pady 10 -sticky ew
842 global newviewtop nextviewnum newviewperm
843 global viewname viewfiles viewperm selectedview
847 set viewname($n) [$newviewtop.name get]
848 set viewperm($n) $newviewperm
850 foreach f [split [$newviewtop.t get 0.0 end] "\n"] {
851 set ft [string trim $f]
856 set viewfiles($n) $files
857 catch {destroy $newviewtop}
859 .bar.view add radiobutton -label $viewname($n) \
860 -command [list showview $n] -variable selectedview -value $n
861 after idle showview $n
867 catch {destroy $newviewtop}
872 global curview viewdata viewperm
874 if {$curview == 0} return
875 set nmenu [.bar.view index end]
876 set targetcmd [list showview $curview]
877 for {set i 5} {$i <= $nmenu} {incr i} {
878 if {[.bar.view entrycget $i -command] eq $targetcmd} {
883 set viewdata($curview) {}
884 set viewperm($curview) 0
892 foreach i [array names $var] {
893 lappend ret $i [set $var\($i\)]
898 proc unflatten {var l} {
908 global curview viewdata viewfiles
909 global displayorder parentlist childlist rowidlist rowoffsets
910 global colormap rowtextx commitrow
911 global numcommits rowrangelist commitlisted idrowranges
912 global selectedline currentid canv canvy0
913 global matchinglines treediffs
914 global pending_select phase
915 global commitidx rowlaidout rowoptim linesegends leftover
916 global commfd nextupdate
919 if {$n == $curview} return
921 if {[info exists selectedline]} {
923 set y [yc $selectedline]
924 set ymax [lindex [$canv cget -scrollregion] 3]
925 set span [$canv yview]
926 set ytop [expr {[lindex $span 0] * $ymax}]
927 set ybot [expr {[lindex $span 1] * $ymax}]
928 if {$ytop < $y && $y < $ybot} {
929 set yscreen [expr {$y - $ytop}]
931 set yscreen [expr {($ybot - $ytop) / 2}]
939 set viewdata($curview) \
940 [list $phase $displayorder $parentlist $childlist $rowidlist \
941 $rowoffsets $rowrangelist $commitlisted \
942 [flatten children] [flatten idrowranges] \
944 $commitidx $rowlaidout $rowoptim $numcommits \
945 $linesegends $leftover $commfd]
946 fileevent $commfd readable {}
947 } elseif {![info exists viewdata($curview)]
948 || [lindex $viewdata($curview) 0] ne {}} {
949 set viewdata($curview) \
950 [list {} $displayorder $parentlist $childlist $rowidlist \
951 $rowoffsets $rowrangelist $commitlisted]
954 catch {unset matchinglines}
955 catch {unset treediffs}
960 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
962 if {![info exists viewdata($n)]} {
963 set pending_select $selid
969 set phase [lindex $v 0]
970 set displayorder [lindex $v 1]
971 set parentlist [lindex $v 2]
972 set childlist [lindex $v 3]
973 set rowidlist [lindex $v 4]
974 set rowoffsets [lindex $v 5]
975 set rowrangelist [lindex $v 6]
976 set commitlisted [lindex $v 7]
978 set numcommits [llength $displayorder]
979 catch {unset idrowranges}
980 catch {unset children}
982 unflatten children [lindex $v 8]
983 unflatten idrowranges [lindex $v 9]
984 unflatten idinlist [lindex $v 10]
985 set commitidx [lindex $v 11]
986 set rowlaidout [lindex $v 12]
987 set rowoptim [lindex $v 13]
988 set numcommits [lindex $v 14]
989 set linesegends [lindex $v 15]
990 set leftover [lindex $v 16]
991 set commfd [lindex $v 17]
992 fileevent $commfd readable [list getcommitlines $commfd]
993 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
996 catch {unset colormap}
997 catch {unset rowtextx}
998 catch {unset commitrow}
1001 foreach id $displayorder {
1002 set commitrow($id) $row
1008 if {$selid ne {} && [info exists commitrow($selid)]} {
1009 set row $commitrow($selid)
1010 # try to get the selected row in the same position on the screen
1011 set ymax [lindex [$canv cget -scrollregion] 3]
1012 set ytop [expr {[yc $row] - $yscreen}]
1016 set yf [expr {$ytop * 1.0 / $ymax}]
1018 allcanvs yview moveto $yf
1022 global maincursor textcursor
1023 . config -cursor $maincursor
1024 settextcursor $textcursor
1026 . config -cursor watch
1031 proc shortids {ids} {
1034 if {[llength $id] > 1} {
1035 lappend res [shortids $id]
1036 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1037 lappend res [string range $id 0 7]
1045 proc incrange {l x o} {
1048 set e [lindex $l $x]
1050 lset l $x [expr {$e + $o}]
1059 for {} {$n > 0} {incr n -1} {
1065 proc usedinrange {id l1 l2} {
1066 global children commitrow childlist
1068 if {[info exists commitrow($id)]} {
1069 set r $commitrow($id)
1070 if {$l1 <= $r && $r <= $l2} {
1071 return [expr {$r - $l1 + 1}]
1073 set kids [lindex $childlist $r]
1075 set kids $children($id)
1078 set r $commitrow($c)
1079 if {$l1 <= $r && $r <= $l2} {
1080 return [expr {$r - $l1 + 1}]
1086 proc sanity {row {full 0}} {
1087 global rowidlist rowoffsets
1090 set ids [lindex $rowidlist $row]
1093 if {$id eq {}} continue
1094 if {$col < [llength $ids] - 1 &&
1095 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1096 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1098 set o [lindex $rowoffsets $row $col]
1104 if {[lindex $rowidlist $y $x] != $id} {
1105 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1106 puts " id=[shortids $id] check started at row $row"
1107 for {set i $row} {$i >= $y} {incr i -1} {
1108 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1113 set o [lindex $rowoffsets $y $x]
1118 proc makeuparrow {oid x y z} {
1119 global rowidlist rowoffsets uparrowlen idrowranges
1121 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1124 set off0 [lindex $rowoffsets $y]
1125 for {set x0 $x} {1} {incr x0} {
1126 if {$x0 >= [llength $off0]} {
1127 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1130 set z [lindex $off0 $x0]
1136 set z [expr {$x0 - $x}]
1137 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1138 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1140 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1141 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1142 lappend idrowranges($oid) $y
1145 proc initlayout {} {
1146 global rowidlist rowoffsets displayorder commitlisted
1147 global rowlaidout rowoptim
1148 global idinlist rowchk rowrangelist idrowranges
1149 global commitidx numcommits canvxmax canv
1151 global parentlist childlist children
1152 global colormap rowtextx commitrow
1162 catch {unset children}
1166 catch {unset idinlist}
1167 catch {unset rowchk}
1170 set canvxmax [$canv cget -width]
1171 catch {unset colormap}
1172 catch {unset rowtextx}
1173 catch {unset commitrow}
1174 catch {unset idrowranges}
1178 proc setcanvscroll {} {
1179 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1181 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1182 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1183 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1184 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1187 proc visiblerows {} {
1188 global canv numcommits linespc
1190 set ymax [lindex [$canv cget -scrollregion] 3]
1191 if {$ymax eq {} || $ymax == 0} return
1193 set y0 [expr {int([lindex $f 0] * $ymax)}]
1194 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1198 set y1 [expr {int([lindex $f 1] * $ymax)}]
1199 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1200 if {$r1 >= $numcommits} {
1201 set r1 [expr {$numcommits - 1}]
1203 return [list $r0 $r1]
1206 proc layoutmore {} {
1207 global rowlaidout rowoptim commitidx numcommits optim_delay
1211 set rowlaidout [layoutrows $row $commitidx 0]
1212 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1213 if {$orow > $rowoptim} {
1214 optimize_rows $rowoptim 0 $orow
1217 set canshow [expr {$rowoptim - $optim_delay}]
1218 if {$canshow > $numcommits} {
1223 proc showstuff {canshow} {
1224 global numcommits commitrow pending_select selectedline
1225 global linesegends idrowranges idrangedrawn
1227 if {$numcommits == 0} {
1229 set phase "incrdraw"
1233 set numcommits $canshow
1235 set rows [visiblerows]
1236 set r0 [lindex $rows 0]
1237 set r1 [lindex $rows 1]
1239 for {set r $row} {$r < $canshow} {incr r} {
1240 foreach id [lindex $linesegends [expr {$r+1}]] {
1242 foreach {s e} [rowranges $id] {
1244 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1245 && ![info exists idrangedrawn($id,$i)]} {
1247 set idrangedrawn($id,$i) 1
1252 if {$canshow > $r1} {
1255 while {$row < $canshow} {
1259 if {[info exists pending_select] &&
1260 [info exists commitrow($pending_select)] &&
1261 $commitrow($pending_select) < $numcommits} {
1262 selectline $commitrow($pending_select) 1
1264 if {![info exists selectedline] && ![info exists pending_select]} {
1269 proc layoutrows {row endrow last} {
1270 global rowidlist rowoffsets displayorder
1271 global uparrowlen downarrowlen maxwidth mingaplen
1272 global childlist parentlist
1273 global idrowranges linesegends
1275 global idinlist rowchk rowrangelist
1277 set idlist [lindex $rowidlist $row]
1278 set offs [lindex $rowoffsets $row]
1279 while {$row < $endrow} {
1280 set id [lindex $displayorder $row]
1283 foreach p [lindex $parentlist $row] {
1284 if {![info exists idinlist($p)]} {
1286 } elseif {!$idinlist($p)} {
1291 set nev [expr {[llength $idlist] + [llength $newolds]
1292 + [llength $oldolds] - $maxwidth + 1}]
1294 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1295 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1296 set i [lindex $idlist $x]
1297 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1298 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1299 [expr {$row + $uparrowlen + $mingaplen}]]
1301 set idlist [lreplace $idlist $x $x]
1302 set offs [lreplace $offs $x $x]
1303 set offs [incrange $offs $x 1]
1305 set rm1 [expr {$row - 1}]
1307 lappend idrowranges($i) $rm1
1308 if {[incr nev -1] <= 0} break
1311 set rowchk($id) [expr {$row + $r}]
1314 lset rowidlist $row $idlist
1315 lset rowoffsets $row $offs
1317 lappend linesegends $lse
1318 set col [lsearch -exact $idlist $id]
1320 set col [llength $idlist]
1322 lset rowidlist $row $idlist
1324 if {[lindex $childlist $row] ne {}} {
1325 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1329 lset rowoffsets $row $offs
1331 makeuparrow $id $col $row $z
1337 if {[info exists idrowranges($id)]} {
1338 set ranges $idrowranges($id)
1340 unset idrowranges($id)
1342 lappend rowrangelist $ranges
1344 set offs [ntimes [llength $idlist] 0]
1345 set l [llength $newolds]
1346 set idlist [eval lreplace \$idlist $col $col $newolds]
1349 set offs [lrange $offs 0 [expr {$col - 1}]]
1350 foreach x $newolds {
1355 set tmp [expr {[llength $idlist] - [llength $offs]}]
1357 set offs [concat $offs [ntimes $tmp $o]]
1362 foreach i $newolds {
1364 set idrowranges($i) $row
1367 foreach oid $oldolds {
1368 set idinlist($oid) 1
1369 set idlist [linsert $idlist $col $oid]
1370 set offs [linsert $offs $col $o]
1371 makeuparrow $oid $col $row $o
1374 lappend rowidlist $idlist
1375 lappend rowoffsets $offs
1380 proc addextraid {id row} {
1381 global displayorder commitrow commitinfo
1382 global commitidx commitlisted
1383 global parentlist childlist children
1386 lappend displayorder $id
1387 lappend commitlisted 0
1388 lappend parentlist {}
1389 set commitrow($id) $row
1391 if {![info exists commitinfo($id)]} {
1392 set commitinfo($id) {"No commit information available"}
1394 if {[info exists children($id)]} {
1395 lappend childlist $children($id)
1398 lappend childlist {}
1402 proc layouttail {} {
1403 global rowidlist rowoffsets idinlist commitidx
1404 global idrowranges rowrangelist
1407 set idlist [lindex $rowidlist $row]
1408 while {$idlist ne {}} {
1409 set col [expr {[llength $idlist] - 1}]
1410 set id [lindex $idlist $col]
1413 lappend idrowranges($id) $row
1414 lappend rowrangelist $idrowranges($id)
1415 unset idrowranges($id)
1417 set offs [ntimes $col 0]
1418 set idlist [lreplace $idlist $col $col]
1419 lappend rowidlist $idlist
1420 lappend rowoffsets $offs
1423 foreach id [array names idinlist] {
1425 lset rowidlist $row [list $id]
1426 lset rowoffsets $row 0
1427 makeuparrow $id 0 $row 0
1428 lappend idrowranges($id) $row
1429 lappend rowrangelist $idrowranges($id)
1430 unset idrowranges($id)
1432 lappend rowidlist {}
1433 lappend rowoffsets {}
1437 proc insert_pad {row col npad} {
1438 global rowidlist rowoffsets
1440 set pad [ntimes $npad {}]
1441 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1442 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1443 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1446 proc optimize_rows {row col endrow} {
1447 global rowidlist rowoffsets idrowranges displayorder
1449 for {} {$row < $endrow} {incr row} {
1450 set idlist [lindex $rowidlist $row]
1451 set offs [lindex $rowoffsets $row]
1453 for {} {$col < [llength $offs]} {incr col} {
1454 if {[lindex $idlist $col] eq {}} {
1458 set z [lindex $offs $col]
1459 if {$z eq {}} continue
1461 set x0 [expr {$col + $z}]
1462 set y0 [expr {$row - 1}]
1463 set z0 [lindex $rowoffsets $y0 $x0]
1465 set id [lindex $idlist $col]
1466 set ranges [rowranges $id]
1467 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
1471 if {$z < -1 || ($z < 0 && $isarrow)} {
1472 set npad [expr {-1 - $z + $isarrow}]
1473 set offs [incrange $offs $col $npad]
1474 insert_pad $y0 $x0 $npad
1476 optimize_rows $y0 $x0 $row
1478 set z [lindex $offs $col]
1479 set x0 [expr {$col + $z}]
1480 set z0 [lindex $rowoffsets $y0 $x0]
1481 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1482 set npad [expr {$z - 1 + $isarrow}]
1483 set y1 [expr {$row + 1}]
1484 set offs2 [lindex $rowoffsets $y1]
1488 if {$z eq {} || $x1 + $z < $col} continue
1489 if {$x1 + $z > $col} {
1492 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1495 set pad [ntimes $npad {}]
1496 set idlist [eval linsert \$idlist $col $pad]
1497 set tmp [eval linsert \$offs $col $pad]
1499 set offs [incrange $tmp $col [expr {-$npad}]]
1500 set z [lindex $offs $col]
1503 if {$z0 eq {} && !$isarrow} {
1504 # this line links to its first child on row $row-2
1505 set rm2 [expr {$row - 2}]
1506 set id [lindex $displayorder $rm2]
1507 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1509 set z0 [expr {$xc - $x0}]
1512 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1513 insert_pad $y0 $x0 1
1514 set offs [incrange $offs $col 1]
1515 optimize_rows $y0 [expr {$x0 + 1}] $row
1520 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1521 set o [lindex $offs $col]
1523 # check if this is the link to the first child
1524 set id [lindex $idlist $col]
1525 set ranges [rowranges $id]
1526 if {$ranges ne {} && $row == [lindex $ranges 0]} {
1527 # it is, work out offset to child
1528 set y0 [expr {$row - 1}]
1529 set id [lindex $displayorder $y0]
1530 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1532 set o [expr {$x0 - $col}]
1536 if {$o eq {} || $o <= 0} break
1538 if {$o ne {} && [incr col] < [llength $idlist]} {
1539 set y1 [expr {$row + 1}]
1540 set offs2 [lindex $rowoffsets $y1]
1544 if {$z eq {} || $x1 + $z < $col} continue
1545 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1548 set idlist [linsert $idlist $col {}]
1549 set tmp [linsert $offs $col {}]
1551 set offs [incrange $tmp $col -1]
1554 lset rowidlist $row $idlist
1555 lset rowoffsets $row $offs
1561 global canvx0 linespc
1562 return [expr {$canvx0 + $col * $linespc}]
1566 global canvy0 linespc
1567 return [expr {$canvy0 + $row * $linespc}]
1570 proc linewidth {id} {
1571 global thickerline lthickness
1574 if {[info exists thickerline] && $id eq $thickerline} {
1575 set wid [expr {2 * $lthickness}]
1580 proc rowranges {id} {
1581 global phase idrowranges commitrow rowlaidout rowrangelist
1585 ([info exists commitrow($id)] && $commitrow($id) < $rowlaidout)} {
1586 set ranges [lindex $rowrangelist $commitrow($id)]
1587 } elseif {[info exists idrowranges($id)]} {
1588 set ranges $idrowranges($id)
1593 proc drawlineseg {id i} {
1594 global rowoffsets rowidlist
1596 global canv colormap linespc
1597 global numcommits commitrow
1599 set ranges [rowranges $id]
1601 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1602 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1606 set startrow [lindex $ranges [expr {2 * $i}]]
1607 set row [lindex $ranges [expr {2 * $i + 1}]]
1608 if {$startrow == $row} return
1611 set col [lsearch -exact [lindex $rowidlist $row] $id]
1613 puts "oops: drawline: id $id not on row $row"
1619 set o [lindex $rowoffsets $row $col]
1622 # changing direction
1623 set x [xc $row $col]
1625 lappend coords $x $y
1631 set x [xc $row $col]
1633 lappend coords $x $y
1635 # draw the link to the first child as part of this line
1637 set child [lindex $displayorder $row]
1638 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1640 set x [xc $row $ccol]
1642 if {$ccol < $col - 1} {
1643 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1644 } elseif {$ccol > $col + 1} {
1645 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1647 lappend coords $x $y
1650 if {[llength $coords] < 4} return
1652 # This line has an arrow at the lower end: check if the arrow is
1653 # on a diagonal segment, and if so, work around the Tk 8.4
1654 # refusal to draw arrows on diagonal lines.
1655 set x0 [lindex $coords 0]
1656 set x1 [lindex $coords 2]
1658 set y0 [lindex $coords 1]
1659 set y1 [lindex $coords 3]
1660 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1661 # we have a nearby vertical segment, just trim off the diag bit
1662 set coords [lrange $coords 2 end]
1664 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1665 set xi [expr {$x0 - $slope * $linespc / 2}]
1666 set yi [expr {$y0 - $linespc / 2}]
1667 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1671 set arrow [expr {2 * ($i > 0) + $downarrow}]
1672 set arrow [lindex {none first last both} $arrow]
1673 set t [$canv create line $coords -width [linewidth $id] \
1674 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1679 proc drawparentlinks {id row col olds} {
1680 global rowidlist canv colormap
1682 set row2 [expr {$row + 1}]
1683 set x [xc $row $col]
1686 set ids [lindex $rowidlist $row2]
1687 # rmx = right-most X coord used
1690 set i [lsearch -exact $ids $p]
1692 puts "oops, parent $p of $id not in list"
1695 set x2 [xc $row2 $i]
1699 set ranges [rowranges $p]
1700 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1701 && $row2 < [lindex $ranges 1]} {
1702 # drawlineseg will do this one for us
1706 # should handle duplicated parents here...
1707 set coords [list $x $y]
1708 if {$i < $col - 1} {
1709 lappend coords [xc $row [expr {$i + 1}]] $y
1710 } elseif {$i > $col + 1} {
1711 lappend coords [xc $row [expr {$i - 1}]] $y
1713 lappend coords $x2 $y2
1714 set t [$canv create line $coords -width [linewidth $p] \
1715 -fill $colormap($p) -tags lines.$p]
1722 proc drawlines {id} {
1723 global colormap canv
1725 global childlist iddrawn commitrow rowidlist
1727 $canv delete lines.$id
1728 set nr [expr {[llength [rowranges $id]] / 2}]
1729 for {set i 0} {$i < $nr} {incr i} {
1730 if {[info exists idrangedrawn($id,$i)]} {
1734 foreach child [lindex $childlist $commitrow($id)] {
1735 if {[info exists iddrawn($child)]} {
1736 set row $commitrow($child)
1737 set col [lsearch -exact [lindex $rowidlist $row] $child]
1739 drawparentlinks $child $row $col [list $id]
1745 proc drawcmittext {id row col rmx} {
1746 global linespc canv canv2 canv3 canvy0
1747 global commitlisted commitinfo rowidlist
1748 global rowtextx idpos idtags idheads idotherrefs
1749 global linehtag linentag linedtag
1750 global mainfont namefont canvxmax
1752 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1753 set x [xc $row $col]
1755 set orad [expr {$linespc / 3}]
1756 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1757 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1758 -fill $ofill -outline black -width 1]
1760 $canv bind $t <1> {selcanvline {} %x %y}
1761 set xt [xc $row [llength [lindex $rowidlist $row]]]
1765 set rowtextx($row) $xt
1766 set idpos($id) [list $x $xt $y]
1767 if {[info exists idtags($id)] || [info exists idheads($id)]
1768 || [info exists idotherrefs($id)]} {
1769 set xt [drawtags $id $x $xt $y]
1771 set headline [lindex $commitinfo($id) 0]
1772 set name [lindex $commitinfo($id) 1]
1773 set date [lindex $commitinfo($id) 2]
1774 set date [formatdate $date]
1775 set linehtag($row) [$canv create text $xt $y -anchor w \
1776 -text $headline -font $mainfont ]
1777 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1778 set linentag($row) [$canv2 create text 3 $y -anchor w \
1779 -text $name -font $namefont]
1780 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1781 -text $date -font $mainfont]
1782 set xr [expr {$xt + [font measure $mainfont $headline]}]
1783 if {$xr > $canvxmax} {
1789 proc drawcmitrow {row} {
1790 global displayorder rowidlist
1791 global idrangedrawn iddrawn
1792 global commitinfo parentlist numcommits
1794 if {$row >= $numcommits} return
1795 foreach id [lindex $rowidlist $row] {
1796 if {$id eq {}} continue
1798 foreach {s e} [rowranges $id] {
1800 if {$row < $s} continue
1803 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1805 set idrangedrawn($id,$i) 1
1812 set id [lindex $displayorder $row]
1813 if {[info exists iddrawn($id)]} return
1814 set col [lsearch -exact [lindex $rowidlist $row] $id]
1816 puts "oops, row $row id $id not in list"
1819 if {![info exists commitinfo($id)]} {
1823 set olds [lindex $parentlist $row]
1825 set rmx [drawparentlinks $id $row $col $olds]
1829 drawcmittext $id $row $col $rmx
1833 proc drawfrac {f0 f1} {
1834 global numcommits canv
1837 set ymax [lindex [$canv cget -scrollregion] 3]
1838 if {$ymax eq {} || $ymax == 0} return
1839 set y0 [expr {int($f0 * $ymax)}]
1840 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1844 set y1 [expr {int($f1 * $ymax)}]
1845 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1846 if {$endrow >= $numcommits} {
1847 set endrow [expr {$numcommits - 1}]
1849 for {} {$row <= $endrow} {incr row} {
1854 proc drawvisible {} {
1856 eval drawfrac [$canv yview]
1859 proc clear_display {} {
1860 global iddrawn idrangedrawn
1863 catch {unset iddrawn}
1864 catch {unset idrangedrawn}
1867 proc findcrossings {id} {
1868 global rowidlist parentlist numcommits rowoffsets displayorder
1872 foreach {s e} [rowranges $id] {
1873 if {$e >= $numcommits} {
1874 set e [expr {$numcommits - 1}]
1876 if {$e <= $s} continue
1877 set x [lsearch -exact [lindex $rowidlist $e] $id]
1879 puts "findcrossings: oops, no [shortids $id] in row $e"
1882 for {set row $e} {[incr row -1] >= $s} {} {
1883 set olds [lindex $parentlist $row]
1884 set kid [lindex $displayorder $row]
1885 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1886 if {$kidx < 0} continue
1887 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1889 set px [lsearch -exact $nextrow $p]
1890 if {$px < 0} continue
1891 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1892 if {[lsearch -exact $ccross $p] >= 0} continue
1893 if {$x == $px + ($kidx < $px? -1: 1)} {
1895 } elseif {[lsearch -exact $cross $p] < 0} {
1900 set inc [lindex $rowoffsets $row $x]
1901 if {$inc eq {}} break
1905 return [concat $ccross {{}} $cross]
1908 proc assigncolor {id} {
1909 global colormap colors nextcolor
1910 global commitrow parentlist children childlist
1912 if {[info exists colormap($id)]} return
1913 set ncolors [llength $colors]
1914 if {[info exists commitrow($id)]} {
1915 set kids [lindex $childlist $commitrow($id)]
1916 } elseif {[info exists children($id)]} {
1917 set kids $children($id)
1921 if {[llength $kids] == 1} {
1922 set child [lindex $kids 0]
1923 if {[info exists colormap($child)]
1924 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1925 set colormap($id) $colormap($child)
1931 foreach x [findcrossings $id] {
1933 # delimiter between corner crossings and other crossings
1934 if {[llength $badcolors] >= $ncolors - 1} break
1935 set origbad $badcolors
1937 if {[info exists colormap($x)]
1938 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1939 lappend badcolors $colormap($x)
1942 if {[llength $badcolors] >= $ncolors} {
1943 set badcolors $origbad
1945 set origbad $badcolors
1946 if {[llength $badcolors] < $ncolors - 1} {
1947 foreach child $kids {
1948 if {[info exists colormap($child)]
1949 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1950 lappend badcolors $colormap($child)
1952 foreach p [lindex $parentlist $commitrow($child)] {
1953 if {[info exists colormap($p)]
1954 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1955 lappend badcolors $colormap($p)
1959 if {[llength $badcolors] >= $ncolors} {
1960 set badcolors $origbad
1963 for {set i 0} {$i <= $ncolors} {incr i} {
1964 set c [lindex $colors $nextcolor]
1965 if {[incr nextcolor] >= $ncolors} {
1968 if {[lsearch -exact $badcolors $c]} break
1970 set colormap($id) $c
1973 proc bindline {t id} {
1976 $canv bind $t <Enter> "lineenter %x %y $id"
1977 $canv bind $t <Motion> "linemotion %x %y $id"
1978 $canv bind $t <Leave> "lineleave $id"
1979 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1982 proc drawtags {id x xt y1} {
1983 global idtags idheads idotherrefs
1984 global linespc lthickness
1985 global canv mainfont commitrow rowtextx
1990 if {[info exists idtags($id)]} {
1991 set marks $idtags($id)
1992 set ntags [llength $marks]
1994 if {[info exists idheads($id)]} {
1995 set marks [concat $marks $idheads($id)]
1996 set nheads [llength $idheads($id)]
1998 if {[info exists idotherrefs($id)]} {
1999 set marks [concat $marks $idotherrefs($id)]
2005 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2006 set yt [expr {$y1 - 0.5 * $linespc}]
2007 set yb [expr {$yt + $linespc - 1}]
2010 foreach tag $marks {
2011 set wid [font measure $mainfont $tag]
2014 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2016 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2017 -width $lthickness -fill black -tags tag.$id]
2019 foreach tag $marks x $xvals wid $wvals {
2020 set xl [expr {$x + $delta}]
2021 set xr [expr {$x + $delta + $wid + $lthickness}]
2022 if {[incr ntags -1] >= 0} {
2024 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2025 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2026 -width 1 -outline black -fill yellow -tags tag.$id]
2027 $canv bind $t <1> [list showtag $tag 1]
2028 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
2030 # draw a head or other ref
2031 if {[incr nheads -1] >= 0} {
2036 set xl [expr {$xl - $delta/2}]
2037 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2038 -width 1 -outline black -fill $col -tags tag.$id
2040 set t [$canv create text $xl $y1 -anchor w -text $tag \
2041 -font $mainfont -tags tag.$id]
2043 $canv bind $t <1> [list showtag $tag 1]
2049 proc xcoord {i level ln} {
2050 global canvx0 xspc1 xspc2
2052 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2053 if {$i > 0 && $i == $level} {
2054 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2055 } elseif {$i > $level} {
2056 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2061 proc finishcommits {} {
2062 global commitidx phase
2063 global canv mainfont ctext maincursor textcursor
2064 global findinprogress pending_select
2066 if {$commitidx > 0} {
2070 $canv create text 3 3 -anchor nw -text "No commits selected" \
2071 -font $mainfont -tags textitems
2073 if {![info exists findinprogress]} {
2074 . config -cursor $maincursor
2075 settextcursor $textcursor
2078 catch {unset pending_select}
2081 # Don't change the text pane cursor if it is currently the hand cursor,
2082 # showing that we are over a sha1 ID link.
2083 proc settextcursor {c} {
2084 global ctext curtextcursor
2086 if {[$ctext cget -cursor] == $curtextcursor} {
2087 $ctext config -cursor $c
2089 set curtextcursor $c
2095 global canvy0 numcommits linespc
2096 global rowlaidout commitidx
2097 global pending_select
2100 layoutrows $rowlaidout $commitidx 1
2102 optimize_rows $row 0 $commitidx
2103 showstuff $commitidx
2104 if {[info exists pending_select]} {
2108 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2109 #puts "overall $drawmsecs ms for $numcommits commits"
2112 proc findmatches {f} {
2113 global findtype foundstring foundstrlen
2114 if {$findtype == "Regexp"} {
2115 set matches [regexp -indices -all -inline $foundstring $f]
2117 if {$findtype == "IgnCase"} {
2118 set str [string tolower $f]
2124 while {[set j [string first $foundstring $str $i]] >= 0} {
2125 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2126 set i [expr {$j + $foundstrlen}]
2133 global findtype findloc findstring markedmatches commitinfo
2134 global numcommits displayorder linehtag linentag linedtag
2135 global mainfont namefont canv canv2 canv3 selectedline
2136 global matchinglines foundstring foundstrlen matchstring
2142 set matchinglines {}
2143 if {$findloc == "Pickaxe"} {
2147 if {$findtype == "IgnCase"} {
2148 set foundstring [string tolower $findstring]
2150 set foundstring $findstring
2152 set foundstrlen [string length $findstring]
2153 if {$foundstrlen == 0} return
2154 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2155 set matchstring "*$matchstring*"
2156 if {$findloc == "Files"} {
2160 if {![info exists selectedline]} {
2163 set oldsel $selectedline
2166 set fldtypes {Headline Author Date Committer CDate Comment}
2168 foreach id $displayorder {
2169 set d $commitdata($id)
2171 if {$findtype == "Regexp"} {
2172 set doesmatch [regexp $foundstring $d]
2173 } elseif {$findtype == "IgnCase"} {
2174 set doesmatch [string match -nocase $matchstring $d]
2176 set doesmatch [string match $matchstring $d]
2178 if {!$doesmatch} continue
2179 if {![info exists commitinfo($id)]} {
2182 set info $commitinfo($id)
2184 foreach f $info ty $fldtypes {
2185 if {$findloc != "All fields" && $findloc != $ty} {
2188 set matches [findmatches $f]
2189 if {$matches == {}} continue
2191 if {$ty == "Headline"} {
2193 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2194 } elseif {$ty == "Author"} {
2196 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2197 } elseif {$ty == "Date"} {
2199 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2203 lappend matchinglines $l
2204 if {!$didsel && $l > $oldsel} {
2210 if {$matchinglines == {}} {
2212 } elseif {!$didsel} {
2213 findselectline [lindex $matchinglines 0]
2217 proc findselectline {l} {
2218 global findloc commentend ctext
2220 if {$findloc == "All fields" || $findloc == "Comments"} {
2221 # highlight the matches in the comments
2222 set f [$ctext get 1.0 $commentend]
2223 set matches [findmatches $f]
2224 foreach match $matches {
2225 set start [lindex $match 0]
2226 set end [expr {[lindex $match 1] + 1}]
2227 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2232 proc findnext {restart} {
2233 global matchinglines selectedline
2234 if {![info exists matchinglines]} {
2240 if {![info exists selectedline]} return
2241 foreach l $matchinglines {
2242 if {$l > $selectedline} {
2251 global matchinglines selectedline
2252 if {![info exists matchinglines]} {
2256 if {![info exists selectedline]} return
2258 foreach l $matchinglines {
2259 if {$l >= $selectedline} break
2263 findselectline $prev
2269 proc findlocchange {name ix op} {
2270 global findloc findtype findtypemenu
2271 if {$findloc == "Pickaxe"} {
2277 $findtypemenu entryconf 1 -state $state
2278 $findtypemenu entryconf 2 -state $state
2281 proc stopfindproc {{done 0}} {
2282 global findprocpid findprocfile findids
2283 global ctext findoldcursor phase maincursor textcursor
2284 global findinprogress
2286 catch {unset findids}
2287 if {[info exists findprocpid]} {
2289 catch {exec kill $findprocpid}
2291 catch {close $findprocfile}
2294 if {[info exists findinprogress]} {
2295 unset findinprogress
2297 . config -cursor $maincursor
2298 settextcursor $textcursor
2303 proc findpatches {} {
2304 global findstring selectedline numcommits
2305 global findprocpid findprocfile
2306 global finddidsel ctext displayorder findinprogress
2307 global findinsertpos
2309 if {$numcommits == 0} return
2311 # make a list of all the ids to search, starting at the one
2312 # after the selected line (if any)
2313 if {[info exists selectedline]} {
2319 for {set i 0} {$i < $numcommits} {incr i} {
2320 if {[incr l] >= $numcommits} {
2323 append inputids [lindex $displayorder $l] "\n"
2327 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2330 error_popup "Error starting search process: $err"
2334 set findinsertpos end
2336 set findprocpid [pid $f]
2337 fconfigure $f -blocking 0
2338 fileevent $f readable readfindproc
2340 . config -cursor watch
2342 set findinprogress 1
2345 proc readfindproc {} {
2346 global findprocfile finddidsel
2347 global commitrow matchinglines findinsertpos
2349 set n [gets $findprocfile line]
2351 if {[eof $findprocfile]} {
2359 if {![regexp {^[0-9a-f]{40}} $line id]} {
2360 error_popup "Can't parse git-diff-tree output: $line"
2364 if {![info exists commitrow($id)]} {
2365 puts stderr "spurious id: $id"
2368 set l $commitrow($id)
2372 proc insertmatch {l id} {
2373 global matchinglines findinsertpos finddidsel
2375 if {$findinsertpos == "end"} {
2376 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2377 set matchinglines [linsert $matchinglines 0 $l]
2380 lappend matchinglines $l
2383 set matchinglines [linsert $matchinglines $findinsertpos $l]
2394 global selectedline numcommits displayorder ctext
2395 global ffileline finddidsel parentlist
2396 global findinprogress findstartline findinsertpos
2397 global treediffs fdiffid fdiffsneeded fdiffpos
2398 global findmergefiles
2400 if {$numcommits == 0} return
2402 if {[info exists selectedline]} {
2403 set l [expr {$selectedline + 1}]
2408 set findstartline $l
2412 set id [lindex $displayorder $l]
2413 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2414 if {![info exists treediffs($id)]} {
2415 append diffsneeded "$id\n"
2416 lappend fdiffsneeded $id
2419 if {[incr l] >= $numcommits} {
2422 if {$l == $findstartline} break
2425 # start off a git-diff-tree process if needed
2426 if {$diffsneeded ne {}} {
2428 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2430 error_popup "Error starting search process: $err"
2433 catch {unset fdiffid}
2435 fconfigure $df -blocking 0
2436 fileevent $df readable [list readfilediffs $df]
2440 set findinsertpos end
2441 set id [lindex $displayorder $l]
2442 . config -cursor watch
2444 set findinprogress 1
2449 proc readfilediffs {df} {
2450 global findid fdiffid fdiffs
2452 set n [gets $df line]
2456 if {[catch {close $df} err]} {
2459 error_popup "Error in git-diff-tree: $err"
2460 } elseif {[info exists findid]} {
2464 error_popup "Couldn't find diffs for $id"
2469 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2470 # start of a new string of diffs
2474 } elseif {[string match ":*" $line]} {
2475 lappend fdiffs [lindex $line 5]
2479 proc donefilediff {} {
2480 global fdiffid fdiffs treediffs findid
2481 global fdiffsneeded fdiffpos
2483 if {[info exists fdiffid]} {
2484 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2485 && $fdiffpos < [llength $fdiffsneeded]} {
2486 # git-diff-tree doesn't output anything for a commit
2487 # which doesn't change anything
2488 set nullid [lindex $fdiffsneeded $fdiffpos]
2489 set treediffs($nullid) {}
2490 if {[info exists findid] && $nullid eq $findid} {
2498 if {![info exists treediffs($fdiffid)]} {
2499 set treediffs($fdiffid) $fdiffs
2501 if {[info exists findid] && $fdiffid eq $findid} {
2509 global findid treediffs parentlist
2510 global ffileline findstartline finddidsel
2511 global displayorder numcommits matchinglines findinprogress
2512 global findmergefiles
2516 set id [lindex $displayorder $l]
2517 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2518 if {![info exists treediffs($id)]} {
2524 foreach f $treediffs($id) {
2525 set x [findmatches $f]
2535 if {[incr l] >= $numcommits} {
2538 if {$l == $findstartline} break
2546 # mark a commit as matching by putting a yellow background
2547 # behind the headline
2548 proc markheadline {l id} {
2549 global canv mainfont linehtag
2552 set bbox [$canv bbox $linehtag($l)]
2553 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2557 # mark the bits of a headline, author or date that match a find string
2558 proc markmatches {canv l str tag matches font} {
2559 set bbox [$canv bbox $tag]
2560 set x0 [lindex $bbox 0]
2561 set y0 [lindex $bbox 1]
2562 set y1 [lindex $bbox 3]
2563 foreach match $matches {
2564 set start [lindex $match 0]
2565 set end [lindex $match 1]
2566 if {$start > $end} continue
2567 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2568 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2569 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2570 [expr {$x0+$xlen+2}] $y1 \
2571 -outline {} -tags matches -fill yellow]
2576 proc unmarkmatches {} {
2577 global matchinglines findids
2578 allcanvs delete matches
2579 catch {unset matchinglines}
2580 catch {unset findids}
2583 proc selcanvline {w x y} {
2584 global canv canvy0 ctext linespc
2586 set ymax [lindex [$canv cget -scrollregion] 3]
2587 if {$ymax == {}} return
2588 set yfrac [lindex [$canv yview] 0]
2589 set y [expr {$y + $yfrac * $ymax}]
2590 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2595 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2601 proc commit_descriptor {p} {
2604 if {[info exists commitinfo($p)]} {
2605 set l [lindex $commitinfo($p) 0]
2610 # append some text to the ctext widget, and make any SHA1 ID
2611 # that we know about be a clickable link.
2612 proc appendwithlinks {text} {
2613 global ctext commitrow linknum
2615 set start [$ctext index "end - 1c"]
2616 $ctext insert end $text
2617 $ctext insert end "\n"
2618 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2622 set linkid [string range $text $s $e]
2623 if {![info exists commitrow($linkid)]} continue
2625 $ctext tag add link "$start + $s c" "$start + $e c"
2626 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2627 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2630 $ctext tag conf link -foreground blue -underline 1
2631 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2632 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2635 proc viewnextline {dir} {
2639 set ymax [lindex [$canv cget -scrollregion] 3]
2640 set wnow [$canv yview]
2641 set wtop [expr {[lindex $wnow 0] * $ymax}]
2642 set newtop [expr {$wtop + $dir * $linespc}]
2645 } elseif {$newtop > $ymax} {
2648 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2651 proc selectline {l isnew} {
2652 global canv canv2 canv3 ctext commitinfo selectedline
2653 global displayorder linehtag linentag linedtag
2654 global canvy0 linespc parentlist childlist
2655 global cflist currentid sha1entry
2656 global commentend idtags linknum
2657 global mergemax numcommits pending_select
2659 catch {unset pending_select}
2662 if {$l < 0 || $l >= $numcommits} return
2663 set y [expr {$canvy0 + $l * $linespc}]
2664 set ymax [lindex [$canv cget -scrollregion] 3]
2665 set ytop [expr {$y - $linespc - 1}]
2666 set ybot [expr {$y + $linespc + 1}]
2667 set wnow [$canv yview]
2668 set wtop [expr {[lindex $wnow 0] * $ymax}]
2669 set wbot [expr {[lindex $wnow 1] * $ymax}]
2670 set wh [expr {$wbot - $wtop}]
2672 if {$ytop < $wtop} {
2673 if {$ybot < $wtop} {
2674 set newtop [expr {$y - $wh / 2.0}]
2677 if {$newtop > $wtop - $linespc} {
2678 set newtop [expr {$wtop - $linespc}]
2681 } elseif {$ybot > $wbot} {
2682 if {$ytop > $wbot} {
2683 set newtop [expr {$y - $wh / 2.0}]
2685 set newtop [expr {$ybot - $wh}]
2686 if {$newtop < $wtop + $linespc} {
2687 set newtop [expr {$wtop + $linespc}]
2691 if {$newtop != $wtop} {
2695 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2699 if {![info exists linehtag($l)]} return
2701 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2702 -tags secsel -fill [$canv cget -selectbackground]]
2704 $canv2 delete secsel
2705 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2706 -tags secsel -fill [$canv2 cget -selectbackground]]
2708 $canv3 delete secsel
2709 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2710 -tags secsel -fill [$canv3 cget -selectbackground]]
2714 addtohistory [list selectline $l 0]
2719 set id [lindex $displayorder $l]
2721 $sha1entry delete 0 end
2722 $sha1entry insert 0 $id
2723 $sha1entry selection from 0
2724 $sha1entry selection to end
2726 $ctext conf -state normal
2727 $ctext delete 0.0 end
2729 $ctext mark set fmark.0 0.0
2730 $ctext mark gravity fmark.0 left
2731 set info $commitinfo($id)
2732 set date [formatdate [lindex $info 2]]
2733 $ctext insert end "Author: [lindex $info 1] $date\n"
2734 set date [formatdate [lindex $info 4]]
2735 $ctext insert end "Committer: [lindex $info 3] $date\n"
2736 if {[info exists idtags($id)]} {
2737 $ctext insert end "Tags:"
2738 foreach tag $idtags($id) {
2739 $ctext insert end " $tag"
2741 $ctext insert end "\n"
2745 set olds [lindex $parentlist $l]
2746 if {[llength $olds] > 1} {
2749 if {$np >= $mergemax} {
2754 $ctext insert end "Parent: " $tag
2755 appendwithlinks [commit_descriptor $p]
2760 append comment "Parent: [commit_descriptor $p]\n"
2764 foreach c [lindex $childlist $l] {
2765 append comment "Child: [commit_descriptor $c]\n"
2768 append comment [lindex $info 5]
2770 # make anything that looks like a SHA1 ID be a clickable link
2771 appendwithlinks $comment
2773 $ctext tag delete Comments
2774 $ctext tag remove found 1.0 end
2775 $ctext conf -state disabled
2776 set commentend [$ctext index "end - 1c"]
2778 $cflist delete 0 end
2779 $cflist insert end "Comments"
2780 if {[llength $olds] <= 1} {
2787 proc selfirstline {} {
2792 proc sellastline {} {
2795 set l [expr {$numcommits - 1}]
2799 proc selnextline {dir} {
2801 if {![info exists selectedline]} return
2802 set l [expr {$selectedline + $dir}]
2807 proc selnextpage {dir} {
2808 global canv linespc selectedline numcommits
2810 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2814 allcanvs yview scroll [expr {$dir * $lpp}] units
2815 if {![info exists selectedline]} return
2816 set l [expr {$selectedline + $dir * $lpp}]
2819 } elseif {$l >= $numcommits} {
2820 set l [expr $numcommits - 1]
2826 proc unselectline {} {
2827 global selectedline currentid
2829 catch {unset selectedline}
2830 catch {unset currentid}
2831 allcanvs delete secsel
2834 proc addtohistory {cmd} {
2835 global history historyindex curview
2837 set elt [list $curview $cmd]
2838 if {$historyindex > 0
2839 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
2843 if {$historyindex < [llength $history]} {
2844 set history [lreplace $history $historyindex end $elt]
2846 lappend history $elt
2849 if {$historyindex > 1} {
2850 .ctop.top.bar.leftbut conf -state normal
2852 .ctop.top.bar.leftbut conf -state disabled
2854 .ctop.top.bar.rightbut conf -state disabled
2860 set view [lindex $elt 0]
2861 set cmd [lindex $elt 1]
2862 if {$curview != $view} {
2869 global history historyindex
2871 if {$historyindex > 1} {
2872 incr historyindex -1
2873 godo [lindex $history [expr {$historyindex - 1}]]
2874 .ctop.top.bar.rightbut conf -state normal
2876 if {$historyindex <= 1} {
2877 .ctop.top.bar.leftbut conf -state disabled
2882 global history historyindex
2884 if {$historyindex < [llength $history]} {
2885 set cmd [lindex $history $historyindex]
2888 .ctop.top.bar.leftbut conf -state normal
2890 if {$historyindex >= [llength $history]} {
2891 .ctop.top.bar.rightbut conf -state disabled
2895 proc mergediff {id l} {
2896 global diffmergeid diffopts mdifffd
2897 global difffilestart diffids
2902 catch {unset difffilestart}
2903 # this doesn't seem to actually affect anything...
2904 set env(GIT_DIFF_OPTS) $diffopts
2905 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2906 if {[catch {set mdf [open $cmd r]} err]} {
2907 error_popup "Error getting merge diffs: $err"
2910 fconfigure $mdf -blocking 0
2911 set mdifffd($id) $mdf
2912 set np [llength [lindex $parentlist $l]]
2913 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2914 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2917 proc getmergediffline {mdf id np} {
2918 global diffmergeid ctext cflist nextupdate mergemax
2919 global difffilestart mdifffd
2921 set n [gets $mdf line]
2928 if {![info exists diffmergeid] || $id != $diffmergeid
2929 || $mdf != $mdifffd($id)} {
2932 $ctext conf -state normal
2933 if {[regexp {^diff --cc (.*)} $line match fname]} {
2934 # start of a new file
2935 $ctext insert end "\n"
2936 set here [$ctext index "end - 1c"]
2937 set i [$cflist index end]
2938 $ctext mark set fmark.$i $here
2939 $ctext mark gravity fmark.$i left
2940 set difffilestart([expr {$i-1}]) $here
2941 $cflist insert end $fname
2942 set l [expr {(78 - [string length $fname]) / 2}]
2943 set pad [string range "----------------------------------------" 1 $l]
2944 $ctext insert end "$pad $fname $pad\n" filesep
2945 } elseif {[regexp {^@@} $line]} {
2946 $ctext insert end "$line\n" hunksep
2947 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2950 # parse the prefix - one ' ', '-' or '+' for each parent
2955 for {set j 0} {$j < $np} {incr j} {
2956 set c [string range $line $j $j]
2959 } elseif {$c == "-"} {
2961 } elseif {$c == "+"} {
2970 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2971 # line doesn't appear in result, parents in $minuses have the line
2972 set num [lindex $minuses 0]
2973 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2974 # line appears in result, parents in $pluses don't have the line
2975 lappend tags mresult
2976 set num [lindex $spaces 0]
2979 if {$num >= $mergemax} {
2984 $ctext insert end "$line\n" $tags
2986 $ctext conf -state disabled
2987 if {[clock clicks -milliseconds] >= $nextupdate} {
2989 fileevent $mdf readable {}
2991 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2995 proc startdiff {ids} {
2996 global treediffs diffids treepending diffmergeid
2999 catch {unset diffmergeid}
3000 if {![info exists treediffs($ids)]} {
3001 if {![info exists treepending]} {
3009 proc addtocflist {ids} {
3010 global treediffs cflist
3011 foreach f $treediffs($ids) {
3012 $cflist insert end $f
3017 proc gettreediffs {ids} {
3018 global treediff treepending
3019 set treepending $ids
3022 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3024 fconfigure $gdtf -blocking 0
3025 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3028 proc gettreediffline {gdtf ids} {
3029 global treediff treediffs treepending diffids diffmergeid
3031 set n [gets $gdtf line]
3033 if {![eof $gdtf]} return
3035 set treediffs($ids) $treediff
3037 if {$ids != $diffids} {
3038 if {![info exists diffmergeid]} {
3039 gettreediffs $diffids
3046 set file [lindex $line 5]
3047 lappend treediff $file
3050 proc getblobdiffs {ids} {
3051 global diffopts blobdifffd diffids env curdifftag curtagstart
3052 global difffilestart nextupdate diffinhdr treediffs
3054 set env(GIT_DIFF_OPTS) $diffopts
3055 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3056 if {[catch {set bdf [open $cmd r]} err]} {
3057 puts "error getting diffs: $err"
3061 fconfigure $bdf -blocking 0
3062 set blobdifffd($ids) $bdf
3063 set curdifftag Comments
3065 catch {unset difffilestart}
3066 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3067 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3070 proc getblobdiffline {bdf ids} {
3071 global diffids blobdifffd ctext curdifftag curtagstart
3072 global diffnexthead diffnextnote difffilestart
3073 global nextupdate diffinhdr treediffs
3075 set n [gets $bdf line]
3079 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3080 $ctext tag add $curdifftag $curtagstart end
3085 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3088 $ctext conf -state normal
3089 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3090 # start of a new file
3091 $ctext insert end "\n"
3092 $ctext tag add $curdifftag $curtagstart end
3093 set curtagstart [$ctext index "end - 1c"]
3095 set here [$ctext index "end - 1c"]
3096 set i [lsearch -exact $treediffs($diffids) $fname]
3098 set difffilestart($i) $here
3100 $ctext mark set fmark.$i $here
3101 $ctext mark gravity fmark.$i left
3103 if {$newname != $fname} {
3104 set i [lsearch -exact $treediffs($diffids) $newname]
3106 set difffilestart($i) $here
3108 $ctext mark set fmark.$i $here
3109 $ctext mark gravity fmark.$i left
3112 set curdifftag "f:$fname"
3113 $ctext tag delete $curdifftag
3114 set l [expr {(78 - [string length $header]) / 2}]
3115 set pad [string range "----------------------------------------" 1 $l]
3116 $ctext insert end "$pad $header $pad\n" filesep
3118 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3120 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3122 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3123 $line match f1l f1c f2l f2c rest]} {
3124 $ctext insert end "$line\n" hunksep
3127 set x [string range $line 0 0]
3128 if {$x == "-" || $x == "+"} {
3129 set tag [expr {$x == "+"}]
3130 $ctext insert end "$line\n" d$tag
3131 } elseif {$x == " "} {
3132 $ctext insert end "$line\n"
3133 } elseif {$diffinhdr || $x == "\\"} {
3134 # e.g. "\ No newline at end of file"
3135 $ctext insert end "$line\n" filesep
3137 # Something else we don't recognize
3138 if {$curdifftag != "Comments"} {
3139 $ctext insert end "\n"
3140 $ctext tag add $curdifftag $curtagstart end
3141 set curtagstart [$ctext index "end - 1c"]
3142 set curdifftag Comments
3144 $ctext insert end "$line\n" filesep
3147 $ctext conf -state disabled
3148 if {[clock clicks -milliseconds] >= $nextupdate} {
3150 fileevent $bdf readable {}
3152 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3157 global difffilestart ctext
3158 set here [$ctext index @0,0]
3159 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3160 if {[$ctext compare $difffilestart($i) > $here]} {
3161 if {![info exists pos]
3162 || [$ctext compare $difffilestart($i) < $pos]} {
3163 set pos $difffilestart($i)
3167 if {[info exists pos]} {
3172 proc listboxsel {} {
3173 global ctext cflist currentid
3174 if {![info exists currentid]} return
3175 set sel [lsort [$cflist curselection]]
3176 if {$sel eq {}} return
3177 set first [lindex $sel 0]
3178 catch {$ctext yview fmark.$first}
3182 global linespc charspc canvx0 canvy0 mainfont
3183 global xspc1 xspc2 lthickness
3185 set linespc [font metrics $mainfont -linespace]
3186 set charspc [font measure $mainfont "m"]
3187 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3188 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3189 set lthickness [expr {int($linespc / 9) + 1}]
3190 set xspc1(0) $linespc
3198 set ymax [lindex [$canv cget -scrollregion] 3]
3199 if {$ymax eq {} || $ymax == 0} return
3200 set span [$canv yview]
3203 allcanvs yview moveto [lindex $span 0]
3205 if {[info exists selectedline]} {
3206 selectline $selectedline 0
3210 proc incrfont {inc} {
3211 global mainfont namefont textfont ctext canv phase
3212 global stopped entries
3214 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3215 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3216 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3218 $ctext conf -font $textfont
3219 $ctext tag conf filesep -font [concat $textfont bold]
3220 foreach e $entries {
3221 $e conf -font $mainfont
3223 if {$phase eq "getcommits"} {
3224 $canv itemconf textitems -font $mainfont
3230 global sha1entry sha1string
3231 if {[string length $sha1string] == 40} {
3232 $sha1entry delete 0 end
3236 proc sha1change {n1 n2 op} {
3237 global sha1string currentid sha1but
3238 if {$sha1string == {}
3239 || ([info exists currentid] && $sha1string == $currentid)} {
3244 if {[$sha1but cget -state] == $state} return
3245 if {$state == "normal"} {
3246 $sha1but conf -state normal -relief raised -text "Goto: "
3248 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3252 proc gotocommit {} {
3253 global sha1string currentid commitrow tagids headids
3254 global displayorder numcommits
3256 if {$sha1string == {}
3257 || ([info exists currentid] && $sha1string == $currentid)} return
3258 if {[info exists tagids($sha1string)]} {
3259 set id $tagids($sha1string)
3260 } elseif {[info exists headids($sha1string)]} {
3261 set id $headids($sha1string)
3263 set id [string tolower $sha1string]
3264 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3266 foreach i $displayorder {
3267 if {[string match $id* $i]} {
3271 if {$matches ne {}} {
3272 if {[llength $matches] > 1} {
3273 error_popup "Short SHA1 id $id is ambiguous"
3276 set id [lindex $matches 0]
3280 if {[info exists commitrow($id)]} {
3281 selectline $commitrow($id) 1
3284 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3289 error_popup "$type $sha1string is not known"
3292 proc lineenter {x y id} {
3293 global hoverx hovery hoverid hovertimer
3294 global commitinfo canv
3296 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3300 if {[info exists hovertimer]} {
3301 after cancel $hovertimer
3303 set hovertimer [after 500 linehover]
3307 proc linemotion {x y id} {
3308 global hoverx hovery hoverid hovertimer
3310 if {[info exists hoverid] && $id == $hoverid} {
3313 if {[info exists hovertimer]} {
3314 after cancel $hovertimer
3316 set hovertimer [after 500 linehover]
3320 proc lineleave {id} {
3321 global hoverid hovertimer canv
3323 if {[info exists hoverid] && $id == $hoverid} {
3325 if {[info exists hovertimer]} {
3326 after cancel $hovertimer
3334 global hoverx hovery hoverid hovertimer
3335 global canv linespc lthickness
3336 global commitinfo mainfont
3338 set text [lindex $commitinfo($hoverid) 0]
3339 set ymax [lindex [$canv cget -scrollregion] 3]
3340 if {$ymax == {}} return
3341 set yfrac [lindex [$canv yview] 0]
3342 set x [expr {$hoverx + 2 * $linespc}]
3343 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3344 set x0 [expr {$x - 2 * $lthickness}]
3345 set y0 [expr {$y - 2 * $lthickness}]
3346 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3347 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3348 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3349 -fill \#ffff80 -outline black -width 1 -tags hover]
3351 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3355 proc clickisonarrow {id y} {
3358 set ranges [rowranges $id]
3359 set thresh [expr {2 * $lthickness + 6}]
3360 set n [expr {[llength $ranges] - 1}]
3361 for {set i 1} {$i < $n} {incr i} {
3362 set row [lindex $ranges $i]
3363 if {abs([yc $row] - $y) < $thresh} {
3370 proc arrowjump {id n y} {
3373 # 1 <-> 2, 3 <-> 4, etc...
3374 set n [expr {(($n - 1) ^ 1) + 1}]
3375 set row [lindex [rowranges $id] $n]
3377 set ymax [lindex [$canv cget -scrollregion] 3]
3378 if {$ymax eq {} || $ymax <= 0} return
3379 set view [$canv yview]
3380 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3381 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3385 allcanvs yview moveto $yfrac
3388 proc lineclick {x y id isnew} {
3389 global ctext commitinfo childlist commitrow cflist canv thickerline
3391 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3396 # draw this line thicker than normal
3400 set ymax [lindex [$canv cget -scrollregion] 3]
3401 if {$ymax eq {}} return
3402 set yfrac [lindex [$canv yview] 0]
3403 set y [expr {$y + $yfrac * $ymax}]
3405 set dirn [clickisonarrow $id $y]
3407 arrowjump $id $dirn $y
3412 addtohistory [list lineclick $x $y $id 0]
3414 # fill the details pane with info about this line
3415 $ctext conf -state normal
3416 $ctext delete 0.0 end
3417 $ctext tag conf link -foreground blue -underline 1
3418 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3419 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3420 $ctext insert end "Parent:\t"
3421 $ctext insert end $id [list link link0]
3422 $ctext tag bind link0 <1> [list selbyid $id]
3423 set info $commitinfo($id)
3424 $ctext insert end "\n\t[lindex $info 0]\n"
3425 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3426 set date [formatdate [lindex $info 2]]
3427 $ctext insert end "\tDate:\t$date\n"
3428 set kids [lindex $childlist $commitrow($id)]
3430 $ctext insert end "\nChildren:"
3432 foreach child $kids {
3434 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3435 set info $commitinfo($child)
3436 $ctext insert end "\n\t"
3437 $ctext insert end $child [list link link$i]
3438 $ctext tag bind link$i <1> [list selbyid $child]
3439 $ctext insert end "\n\t[lindex $info 0]"
3440 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3441 set date [formatdate [lindex $info 2]]
3442 $ctext insert end "\n\tDate:\t$date\n"
3445 $ctext conf -state disabled
3447 $cflist delete 0 end
3450 proc normalline {} {
3452 if {[info exists thickerline]} {
3461 if {[info exists commitrow($id)]} {
3462 selectline $commitrow($id) 1
3468 if {![info exists startmstime]} {
3469 set startmstime [clock clicks -milliseconds]
3471 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3474 proc rowmenu {x y id} {
3475 global rowctxmenu commitrow selectedline rowmenuid
3477 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3482 $rowctxmenu entryconfigure 0 -state $state
3483 $rowctxmenu entryconfigure 1 -state $state
3484 $rowctxmenu entryconfigure 2 -state $state
3486 tk_popup $rowctxmenu $x $y
3489 proc diffvssel {dirn} {
3490 global rowmenuid selectedline displayorder
3492 if {![info exists selectedline]} return
3494 set oldid [lindex $displayorder $selectedline]
3495 set newid $rowmenuid
3497 set oldid $rowmenuid
3498 set newid [lindex $displayorder $selectedline]
3500 addtohistory [list doseldiff $oldid $newid]
3501 doseldiff $oldid $newid
3504 proc doseldiff {oldid newid} {
3508 $ctext conf -state normal
3509 $ctext delete 0.0 end
3510 $ctext mark set fmark.0 0.0
3511 $ctext mark gravity fmark.0 left
3512 $cflist delete 0 end
3513 $cflist insert end "Top"
3514 $ctext insert end "From "
3515 $ctext tag conf link -foreground blue -underline 1
3516 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3517 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3518 $ctext tag bind link0 <1> [list selbyid $oldid]
3519 $ctext insert end $oldid [list link link0]
3520 $ctext insert end "\n "
3521 $ctext insert end [lindex $commitinfo($oldid) 0]
3522 $ctext insert end "\n\nTo "
3523 $ctext tag bind link1 <1> [list selbyid $newid]
3524 $ctext insert end $newid [list link link1]
3525 $ctext insert end "\n "
3526 $ctext insert end [lindex $commitinfo($newid) 0]
3527 $ctext insert end "\n"
3528 $ctext conf -state disabled
3529 $ctext tag delete Comments
3530 $ctext tag remove found 1.0 end
3531 startdiff [list $oldid $newid]
3535 global rowmenuid currentid commitinfo patchtop patchnum
3537 if {![info exists currentid]} return
3538 set oldid $currentid
3539 set oldhead [lindex $commitinfo($oldid) 0]
3540 set newid $rowmenuid
3541 set newhead [lindex $commitinfo($newid) 0]
3544 catch {destroy $top}
3546 label $top.title -text "Generate patch"
3547 grid $top.title - -pady 10
3548 label $top.from -text "From:"
3549 entry $top.fromsha1 -width 40 -relief flat
3550 $top.fromsha1 insert 0 $oldid
3551 $top.fromsha1 conf -state readonly
3552 grid $top.from $top.fromsha1 -sticky w
3553 entry $top.fromhead -width 60 -relief flat
3554 $top.fromhead insert 0 $oldhead
3555 $top.fromhead conf -state readonly
3556 grid x $top.fromhead -sticky w
3557 label $top.to -text "To:"
3558 entry $top.tosha1 -width 40 -relief flat
3559 $top.tosha1 insert 0 $newid
3560 $top.tosha1 conf -state readonly
3561 grid $top.to $top.tosha1 -sticky w
3562 entry $top.tohead -width 60 -relief flat
3563 $top.tohead insert 0 $newhead
3564 $top.tohead conf -state readonly
3565 grid x $top.tohead -sticky w
3566 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3567 grid $top.rev x -pady 10
3568 label $top.flab -text "Output file:"
3569 entry $top.fname -width 60
3570 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3572 grid $top.flab $top.fname -sticky w
3574 button $top.buts.gen -text "Generate" -command mkpatchgo
3575 button $top.buts.can -text "Cancel" -command mkpatchcan
3576 grid $top.buts.gen $top.buts.can
3577 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3578 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3579 grid $top.buts - -pady 10 -sticky ew
3583 proc mkpatchrev {} {
3586 set oldid [$patchtop.fromsha1 get]
3587 set oldhead [$patchtop.fromhead get]
3588 set newid [$patchtop.tosha1 get]
3589 set newhead [$patchtop.tohead get]
3590 foreach e [list fromsha1 fromhead tosha1 tohead] \
3591 v [list $newid $newhead $oldid $oldhead] {
3592 $patchtop.$e conf -state normal
3593 $patchtop.$e delete 0 end
3594 $patchtop.$e insert 0 $v
3595 $patchtop.$e conf -state readonly
3602 set oldid [$patchtop.fromsha1 get]
3603 set newid [$patchtop.tosha1 get]
3604 set fname [$patchtop.fname get]
3605 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3606 error_popup "Error creating patch: $err"
3608 catch {destroy $patchtop}
3612 proc mkpatchcan {} {
3615 catch {destroy $patchtop}
3620 global rowmenuid mktagtop commitinfo
3624 catch {destroy $top}
3626 label $top.title -text "Create tag"
3627 grid $top.title - -pady 10
3628 label $top.id -text "ID:"
3629 entry $top.sha1 -width 40 -relief flat
3630 $top.sha1 insert 0 $rowmenuid
3631 $top.sha1 conf -state readonly
3632 grid $top.id $top.sha1 -sticky w
3633 entry $top.head -width 60 -relief flat
3634 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3635 $top.head conf -state readonly
3636 grid x $top.head -sticky w
3637 label $top.tlab -text "Tag name:"
3638 entry $top.tag -width 60
3639 grid $top.tlab $top.tag -sticky w
3641 button $top.buts.gen -text "Create" -command mktaggo
3642 button $top.buts.can -text "Cancel" -command mktagcan
3643 grid $top.buts.gen $top.buts.can
3644 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3645 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3646 grid $top.buts - -pady 10 -sticky ew
3651 global mktagtop env tagids idtags
3653 set id [$mktagtop.sha1 get]
3654 set tag [$mktagtop.tag get]
3656 error_popup "No tag name specified"
3659 if {[info exists tagids($tag)]} {
3660 error_popup "Tag \"$tag\" already exists"
3665 set fname [file join $dir "refs/tags" $tag]
3666 set f [open $fname w]
3670 error_popup "Error creating tag: $err"
3674 set tagids($tag) $id
3675 lappend idtags($id) $tag
3679 proc redrawtags {id} {
3680 global canv linehtag commitrow idpos selectedline
3682 if {![info exists commitrow($id)]} return
3683 drawcmitrow $commitrow($id)
3684 $canv delete tag.$id
3685 set xt [eval drawtags $id $idpos($id)]
3686 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3687 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3688 selectline $selectedline 0
3695 catch {destroy $mktagtop}
3704 proc writecommit {} {
3705 global rowmenuid wrcomtop commitinfo wrcomcmd
3707 set top .writecommit
3709 catch {destroy $top}
3711 label $top.title -text "Write commit to file"
3712 grid $top.title - -pady 10
3713 label $top.id -text "ID:"
3714 entry $top.sha1 -width 40 -relief flat
3715 $top.sha1 insert 0 $rowmenuid
3716 $top.sha1 conf -state readonly
3717 grid $top.id $top.sha1 -sticky w
3718 entry $top.head -width 60 -relief flat
3719 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3720 $top.head conf -state readonly
3721 grid x $top.head -sticky w
3722 label $top.clab -text "Command:"
3723 entry $top.cmd -width 60 -textvariable wrcomcmd
3724 grid $top.clab $top.cmd -sticky w -pady 10
3725 label $top.flab -text "Output file:"
3726 entry $top.fname -width 60
3727 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3728 grid $top.flab $top.fname -sticky w
3730 button $top.buts.gen -text "Write" -command wrcomgo
3731 button $top.buts.can -text "Cancel" -command wrcomcan
3732 grid $top.buts.gen $top.buts.can
3733 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3734 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3735 grid $top.buts - -pady 10 -sticky ew
3742 set id [$wrcomtop.sha1 get]
3743 set cmd "echo $id | [$wrcomtop.cmd get]"
3744 set fname [$wrcomtop.fname get]
3745 if {[catch {exec sh -c $cmd >$fname &} err]} {
3746 error_popup "Error writing commit: $err"
3748 catch {destroy $wrcomtop}
3755 catch {destroy $wrcomtop}
3759 proc listrefs {id} {
3760 global idtags idheads idotherrefs
3763 if {[info exists idtags($id)]} {
3767 if {[info exists idheads($id)]} {
3771 if {[info exists idotherrefs($id)]} {
3772 set z $idotherrefs($id)
3774 return [list $x $y $z]
3777 proc rereadrefs {} {
3778 global idtags idheads idotherrefs
3780 set refids [concat [array names idtags] \
3781 [array names idheads] [array names idotherrefs]]
3782 foreach id $refids {
3783 if {![info exists ref($id)]} {
3784 set ref($id) [listrefs $id]
3788 set refids [lsort -unique [concat $refids [array names idtags] \
3789 [array names idheads] [array names idotherrefs]]]
3790 foreach id $refids {
3791 set v [listrefs $id]
3792 if {![info exists ref($id)] || $ref($id) != $v} {
3798 proc showtag {tag isnew} {
3799 global ctext cflist tagcontents tagids linknum
3802 addtohistory [list showtag $tag 0]
3804 $ctext conf -state normal
3805 $ctext delete 0.0 end
3807 if {[info exists tagcontents($tag)]} {
3808 set text $tagcontents($tag)
3810 set text "Tag: $tag\nId: $tagids($tag)"
3812 appendwithlinks $text
3813 $ctext conf -state disabled
3814 $cflist delete 0 end
3824 global maxwidth maxgraphpct diffopts findmergefiles
3825 global oldprefs prefstop
3829 if {[winfo exists $top]} {
3833 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3834 set oldprefs($v) [set $v]
3837 wm title $top "Gitk preferences"
3838 label $top.ldisp -text "Commit list display options"
3839 grid $top.ldisp - -sticky w -pady 10
3840 label $top.spacer -text " "
3841 label $top.maxwidthl -text "Maximum graph width (lines)" \
3843 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3844 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3845 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3847 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3848 grid x $top.maxpctl $top.maxpct -sticky w
3849 checkbutton $top.findm -variable findmergefiles
3850 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3852 grid $top.findm $top.findml - -sticky w
3853 label $top.ddisp -text "Diff display options"
3854 grid $top.ddisp - -sticky w -pady 10
3855 label $top.diffoptl -text "Options for diff program" \
3857 entry $top.diffopt -width 20 -textvariable diffopts
3858 grid x $top.diffoptl $top.diffopt -sticky w
3860 button $top.buts.ok -text "OK" -command prefsok
3861 button $top.buts.can -text "Cancel" -command prefscan
3862 grid $top.buts.ok $top.buts.can
3863 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3864 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3865 grid $top.buts - - -pady 10 -sticky ew
3869 global maxwidth maxgraphpct diffopts findmergefiles
3870 global oldprefs prefstop
3872 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3873 set $v $oldprefs($v)
3875 catch {destroy $prefstop}
3880 global maxwidth maxgraphpct
3881 global oldprefs prefstop
3883 catch {destroy $prefstop}
3885 if {$maxwidth != $oldprefs(maxwidth)
3886 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3891 proc formatdate {d} {
3892 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3895 # This list of encoding names and aliases is distilled from
3896 # http://www.iana.org/assignments/character-sets.
3897 # Not all of them are supported by Tcl.
3898 set encoding_aliases {
3899 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3900 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3901 { ISO-10646-UTF-1 csISO10646UTF1 }
3902 { ISO_646.basic:1983 ref csISO646basic1983 }
3903 { INVARIANT csINVARIANT }
3904 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3905 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3906 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3907 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3908 { NATS-DANO iso-ir-9-1 csNATSDANO }
3909 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3910 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3911 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3912 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3913 { ISO-2022-KR csISO2022KR }
3915 { ISO-2022-JP csISO2022JP }
3916 { ISO-2022-JP-2 csISO2022JP2 }
3917 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3919 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3920 { IT iso-ir-15 ISO646-IT csISO15Italian }
3921 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3922 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3923 { greek7-old iso-ir-18 csISO18Greek7Old }
3924 { latin-greek iso-ir-19 csISO19LatinGreek }
3925 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3926 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3927 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3928 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3929 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3930 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3931 { INIS iso-ir-49 csISO49INIS }
3932 { INIS-8 iso-ir-50 csISO50INIS8 }
3933 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3934 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3935 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3936 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3937 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3938 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3940 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3941 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3942 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3943 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3944 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3945 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3946 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3947 { greek7 iso-ir-88 csISO88Greek7 }
3948 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3949 { iso-ir-90 csISO90 }
3950 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3951 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3952 csISO92JISC62991984b }
3953 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3954 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3955 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3956 csISO95JIS62291984handadd }
3957 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3958 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3959 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3960 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3962 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3963 { T.61-7bit iso-ir-102 csISO102T617bit }
3964 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3965 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3966 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3967 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3968 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3969 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3970 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3971 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3972 arabic csISOLatinArabic }
3973 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3974 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3975 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3976 greek greek8 csISOLatinGreek }
3977 { T.101-G2 iso-ir-128 csISO128T101G2 }
3978 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3980 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3981 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3982 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3983 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3984 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3985 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3986 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3987 csISOLatinCyrillic }
3988 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3989 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3990 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3991 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3992 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3993 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3994 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3995 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3996 { ISO_10367-box iso-ir-155 csISO10367Box }
3997 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3998 { latin-lap lap iso-ir-158 csISO158Lap }
3999 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4000 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4003 { JIS_X0201 X0201 csHalfWidthKatakana }
4004 { KSC5636 ISO646-KR csKSC5636 }
4005 { ISO-10646-UCS-2 csUnicode }
4006 { ISO-10646-UCS-4 csUCS4 }
4007 { DEC-MCS dec csDECMCS }
4008 { hp-roman8 roman8 r8 csHPRoman8 }
4009 { macintosh mac csMacintosh }
4010 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4012 { IBM038 EBCDIC-INT cp038 csIBM038 }
4013 { IBM273 CP273 csIBM273 }
4014 { IBM274 EBCDIC-BE CP274 csIBM274 }
4015 { IBM275 EBCDIC-BR cp275 csIBM275 }
4016 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4017 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4018 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4019 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4020 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4021 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4022 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4023 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4024 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4025 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4026 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4027 { IBM437 cp437 437 csPC8CodePage437 }
4028 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4029 { IBM775 cp775 csPC775Baltic }
4030 { IBM850 cp850 850 csPC850Multilingual }
4031 { IBM851 cp851 851 csIBM851 }
4032 { IBM852 cp852 852 csPCp852 }
4033 { IBM855 cp855 855 csIBM855 }
4034 { IBM857 cp857 857 csIBM857 }
4035 { IBM860 cp860 860 csIBM860 }
4036 { IBM861 cp861 861 cp-is csIBM861 }
4037 { IBM862 cp862 862 csPC862LatinHebrew }
4038 { IBM863 cp863 863 csIBM863 }
4039 { IBM864 cp864 csIBM864 }
4040 { IBM865 cp865 865 csIBM865 }
4041 { IBM866 cp866 866 csIBM866 }
4042 { IBM868 CP868 cp-ar csIBM868 }
4043 { IBM869 cp869 869 cp-gr csIBM869 }
4044 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4045 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4046 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4047 { IBM891 cp891 csIBM891 }
4048 { IBM903 cp903 csIBM903 }
4049 { IBM904 cp904 904 csIBBM904 }
4050 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4051 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4052 { IBM1026 CP1026 csIBM1026 }
4053 { EBCDIC-AT-DE csIBMEBCDICATDE }
4054 { EBCDIC-AT-DE-A csEBCDICATDEA }
4055 { EBCDIC-CA-FR csEBCDICCAFR }
4056 { EBCDIC-DK-NO csEBCDICDKNO }
4057 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4058 { EBCDIC-FI-SE csEBCDICFISE }
4059 { EBCDIC-FI-SE-A csEBCDICFISEA }
4060 { EBCDIC-FR csEBCDICFR }
4061 { EBCDIC-IT csEBCDICIT }
4062 { EBCDIC-PT csEBCDICPT }
4063 { EBCDIC-ES csEBCDICES }
4064 { EBCDIC-ES-A csEBCDICESA }
4065 { EBCDIC-ES-S csEBCDICESS }
4066 { EBCDIC-UK csEBCDICUK }
4067 { EBCDIC-US csEBCDICUS }
4068 { UNKNOWN-8BIT csUnknown8BiT }
4069 { MNEMONIC csMnemonic }
4074 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4075 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4076 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4077 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4078 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4079 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4080 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4081 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4082 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4083 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4084 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4085 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4086 { IBM1047 IBM-1047 }
4087 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4088 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4089 { UNICODE-1-1 csUnicode11 }
4092 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4093 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4095 { ISO-8859-15 ISO_8859-15 Latin-9 }
4096 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4097 { GBK CP936 MS936 windows-936 }
4098 { JIS_Encoding csJISEncoding }
4099 { Shift_JIS MS_Kanji csShiftJIS }
4100 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4102 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4103 { ISO-10646-UCS-Basic csUnicodeASCII }
4104 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4105 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4106 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4107 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4108 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4109 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4110 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4111 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4112 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4113 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4114 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4115 { Ventura-US csVenturaUS }
4116 { Ventura-International csVenturaInternational }
4117 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4118 { PC8-Turkish csPC8Turkish }
4119 { IBM-Symbols csIBMSymbols }
4120 { IBM-Thai csIBMThai }
4121 { HP-Legal csHPLegal }
4122 { HP-Pi-font csHPPiFont }
4123 { HP-Math8 csHPMath8 }
4124 { Adobe-Symbol-Encoding csHPPSMath }
4125 { HP-DeskTop csHPDesktop }
4126 { Ventura-Math csVenturaMath }
4127 { Microsoft-Publishing csMicrosoftPublishing }
4128 { Windows-31J csWindows31J }
4133 proc tcl_encoding {enc} {
4134 global encoding_aliases
4135 set names [encoding names]
4136 set lcnames [string tolower $names]
4137 set enc [string tolower $enc]
4138 set i [lsearch -exact $lcnames $enc]
4140 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4141 if {[regsub {^iso[-_]} $enc iso encx]} {
4142 set i [lsearch -exact $lcnames $encx]
4146 foreach l $encoding_aliases {
4147 set ll [string tolower $l]
4148 if {[lsearch -exact $ll $enc] < 0} continue
4149 # look through the aliases for one that tcl knows about
4151 set i [lsearch -exact $lcnames $e]
4153 if {[regsub {^iso[-_]} $e iso ex]} {
4154 set i [lsearch -exact $lcnames $ex]
4163 return [lindex $names $i]
4170 set diffopts "-U 5 -p"
4171 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4175 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4177 if {$gitencoding == ""} {
4178 set gitencoding "utf-8"
4180 set tclencoding [tcl_encoding $gitencoding]
4181 if {$tclencoding == {}} {
4182 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4185 set mainfont {Helvetica 9}
4186 set textfont {Courier 9}
4187 set uifont {Helvetica 9 bold}
4188 set findmergefiles 0
4197 set colors {green red blue magenta darkgrey brown orange}
4199 catch {source ~/.gitk}
4201 set namefont $mainfont
4203 font create optionfont -family sans-serif -size -12
4207 switch -regexp -- $arg {
4209 "^-d" { set datemode 1 }
4211 lappend revtreeargs $arg
4216 # check that we can find a .git directory somewhere...
4218 if {![file isdirectory $gitdir]} {
4219 error_popup "Cannot find the git directory \"$gitdir\"."
4241 set cmdline_files {}
4243 set fileargs [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
4244 set cmdline_files [split $fileargs "\n"]
4245 set n [llength $cmdline_files]
4246 set revtreeargs [lrange $revtreeargs 0 end-$n]
4248 if {[lindex $revtreeargs end] eq "--"} {
4249 set revtreeargs [lrange $revtreeargs 0 end-1]
4252 if {$cmdline_files ne {}} {
4253 # create a view for the files/dirs specified on the command line
4257 set viewname(1) "Command line"
4258 set viewfiles(1) $cmdline_files
4260 .bar.view add radiobutton -label $viewname(1) -command {showview 1} \
4261 -variable selectedview -value 1
4262 .bar.view entryconf 2 -state normal
4265 if {[info exists permviews]} {
4266 foreach v $permviews {
4269 set viewname($n) [lindex $v 0]
4270 set viewfiles($n) [lindex $v 1]
4272 .bar.view add radiobutton -label $viewname($n) \
4273 -command [list showview $n] -variable selectedview -value $n