2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env(GIT_DIR)]} {
19 proc parse_args {rargs} {
20 global parsed_args cmdline_files
25 set args [concat --default HEAD $rargs]
26 set args [split [eval exec git-rev-parse $args] "\n"]
29 if {![regexp {^[0-9a-f]{40}$} $arg]} {
33 set cmdline_files [lrange $args $i end]
36 lappend parsed_args $arg
40 # if git-rev-parse failed for some reason...
41 set i [lsearch -exact $rargs "--"]
43 set cmdline_files [lrange $rargs [expr {$i+1}] end]
44 set rargs [lrange $rargs 0 [expr {$i-1}]]
49 set parsed_args $rargs
54 proc start_rev_list {rlargs} {
55 global startmsecs nextupdate ncmupdate
56 global commfd leftover tclencoding datemode
58 set startmsecs [clock clicks -milliseconds]
59 set nextupdate [expr {$startmsecs + 100}]
62 set order "--topo-order"
64 set order "--date-order"
67 set commfd [open [concat | git-rev-list --header $order \
68 --parents --boundary $rlargs] r]
70 puts stderr "Error executing git-rev-list: $err"
74 fconfigure $commfd -blocking 0 -translation lf
75 if {$tclencoding != {}} {
76 fconfigure $commfd -encoding $tclencoding
78 fileevent $commfd readable [list getcommitlines $commfd]
79 . config -cursor watch
83 proc getcommits {rargs} {
84 global phase canv mainfont
89 $canv create text 3 3 -anchor nw -text "Reading commits..." \
90 -font $mainfont -tags textitems
93 proc getcommitlines {commfd} {
94 global commitlisted nextupdate
96 global displayorder commitidx commitrow commitdata
97 global parentlist childlist children
99 set stuff [read $commfd]
101 if {![eof $commfd]} return
102 # set it blocking so we wait for the process to terminate
103 fconfigure $commfd -blocking 1
104 if {![catch {close $commfd} err]} {
105 after idle finishcommits
108 if {[string range $err 0 4] == "usage"} {
110 "Gitk: error reading commits: bad arguments to git-rev-list.\
111 (Note: arguments to gitk are passed to git-rev-list\
112 to allow selection of commits to be displayed.)"
114 set err "Error reading commits: $err"
122 set i [string first "\0" $stuff $start]
124 append leftover [string range $stuff $start end]
129 append cmit [string range $stuff 0 [expr {$i - 1}]]
132 set cmit [string range $stuff $start [expr {$i - 1}]]
134 set start [expr {$i + 1}]
135 set j [string first "\n" $cmit]
139 set ids [string range $cmit 0 [expr {$j - 1}]]
140 if {[string range $ids 0 0] == "-"} {
142 set ids [string range $ids 1 end]
146 if {[string length $id] != 40} {
154 if {[string length $shortcmit] > 80} {
155 set shortcmit "[string range $shortcmit 0 80]..."
157 error_popup "Can't parse git-rev-list output: {$shortcmit}"
160 set id [lindex $ids 0]
162 set olds [lrange $ids 1 end]
165 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
166 lappend children($p) $id
173 lappend parentlist $olds
174 if {[info exists children($id)]} {
175 lappend childlist $children($id)
179 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
180 set commitrow($id) $commitidx
182 lappend displayorder $id
183 lappend commitlisted $listed
189 if {[clock clicks -milliseconds] >= $nextupdate} {
194 proc doupdate {reading} {
195 global commfd nextupdate numcommits ncmupdate
198 fileevent $commfd readable {}
201 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
202 if {$numcommits < 100} {
203 set ncmupdate [expr {$numcommits + 1}]
204 } elseif {$numcommits < 10000} {
205 set ncmupdate [expr {$numcommits + 10}]
207 set ncmupdate [expr {$numcommits + 100}]
210 fileevent $commfd readable [list getcommitlines $commfd]
214 proc readcommit {id} {
215 if {[catch {set contents [exec git-cat-file commit $id]}]} return
216 parsecommit $id $contents 0
219 proc updatecommits {} {
220 global viewdata curview revtreeargs
224 catch {unset viewdata($n)}
225 parse_args $revtreeargs
230 proc parsecommit {id contents listed} {
231 global commitinfo cdate
240 set hdrend [string first "\n\n" $contents]
242 # should never happen...
243 set hdrend [string length $contents]
245 set header [string range $contents 0 [expr {$hdrend - 1}]]
246 set comment [string range $contents [expr {$hdrend + 2}] end]
247 foreach line [split $header "\n"] {
248 set tag [lindex $line 0]
249 if {$tag == "author"} {
250 set audate [lindex $line end-1]
251 set auname [lrange $line 1 end-2]
252 } elseif {$tag == "committer"} {
253 set comdate [lindex $line end-1]
254 set comname [lrange $line 1 end-2]
258 # take the first line of the comment as the headline
259 set i [string first "\n" $comment]
261 set headline [string trim [string range $comment 0 $i]]
263 set headline $comment
266 # git-rev-list indents the comment by 4 spaces;
267 # if we got this via git-cat-file, add the indentation
269 foreach line [split $comment "\n"] {
270 append newcomment " "
271 append newcomment $line
272 append newcomment "\n"
274 set comment $newcomment
276 if {$comdate != {}} {
277 set cdate($id) $comdate
279 set commitinfo($id) [list $headline $auname $audate \
280 $comname $comdate $comment]
283 proc getcommit {id} {
284 global commitdata commitinfo
286 if {[info exists commitdata($id)]} {
287 parsecommit $id $commitdata($id) 1
290 if {![info exists commitinfo($id)]} {
291 set commitinfo($id) {"No commit information available"}
298 global tagids idtags headids idheads tagcontents
299 global otherrefids idotherrefs
301 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
304 set refd [open [list | git ls-remote [gitdir]] r]
305 while {0 <= [set n [gets $refd line]]} {
306 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
310 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
314 if {$type == "tags"} {
315 set tagids($name) $id
316 lappend idtags($id) $name
321 set commit [exec git-rev-parse "$id^0"]
322 if {"$commit" != "$id"} {
323 set tagids($name) $commit
324 lappend idtags($commit) $name
328 set tagcontents($name) [exec git-cat-file tag "$id"]
330 } elseif { $type == "heads" } {
331 set headids($name) $id
332 lappend idheads($id) $name
334 set otherrefids($name) $id
335 lappend idotherrefs($id) $name
341 proc error_popup msg {
345 message $w.m -text $msg -justify center -aspect 400
346 pack $w.m -side top -fill x -padx 20 -pady 20
347 button $w.ok -text OK -command "destroy $w"
348 pack $w.ok -side bottom -fill x
349 bind $w <Visibility> "grab $w; focus $w"
350 bind $w <Key-Return> "destroy $w"
355 global canv canv2 canv3 linespc charspc ctext cflist
356 global textfont mainfont uifont
357 global findtype findtypemenu findloc findstring fstring geometry
358 global entries sha1entry sha1string sha1but
359 global maincursor textcursor curtextcursor
360 global rowctxmenu mergemax
363 .bar add cascade -label "File" -menu .bar.file
364 .bar configure -font $uifont
366 .bar.file add command -label "Update" -command updatecommits
367 .bar.file add command -label "Reread references" -command rereadrefs
368 .bar.file add command -label "Quit" -command doquit
369 .bar.file configure -font $uifont
371 .bar add cascade -label "Edit" -menu .bar.edit
372 .bar.edit add command -label "Preferences" -command doprefs
373 .bar.edit configure -font $uifont
374 menu .bar.view -font $uifont
375 .bar add cascade -label "View" -menu .bar.view
376 .bar.view add command -label "New view..." -command newview
377 .bar.view add command -label "Delete view" -command delview -state disabled
378 .bar.view add separator
379 .bar.view add command -label "All files" -command {showview 0}
381 .bar add cascade -label "Help" -menu .bar.help
382 .bar.help add command -label "About gitk" -command about
383 .bar.help add command -label "Key bindings" -command keys
384 .bar.help configure -font $uifont
385 . configure -menu .bar
387 if {![info exists geometry(canv1)]} {
388 set geometry(canv1) [expr {45 * $charspc}]
389 set geometry(canv2) [expr {30 * $charspc}]
390 set geometry(canv3) [expr {15 * $charspc}]
391 set geometry(canvh) [expr {25 * $linespc + 4}]
392 set geometry(ctextw) 80
393 set geometry(ctexth) 30
394 set geometry(cflistw) 30
396 panedwindow .ctop -orient vertical
397 if {[info exists geometry(width)]} {
398 .ctop conf -width $geometry(width) -height $geometry(height)
399 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
400 set geometry(ctexth) [expr {($texth - 8) /
401 [font metrics $textfont -linespace]}]
405 pack .ctop.top.bar -side bottom -fill x
406 set cscroll .ctop.top.csb
407 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
408 pack $cscroll -side right -fill y
409 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
410 pack .ctop.top.clist -side top -fill both -expand 1
412 set canv .ctop.top.clist.canv
413 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
415 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
416 .ctop.top.clist add $canv
417 set canv2 .ctop.top.clist.canv2
418 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
419 -bg white -bd 0 -yscrollincr $linespc
420 .ctop.top.clist add $canv2
421 set canv3 .ctop.top.clist.canv3
422 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
423 -bg white -bd 0 -yscrollincr $linespc
424 .ctop.top.clist add $canv3
425 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
427 set sha1entry .ctop.top.bar.sha1
428 set entries $sha1entry
429 set sha1but .ctop.top.bar.sha1label
430 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
431 -command gotocommit -width 8 -font $uifont
432 $sha1but conf -disabledforeground [$sha1but cget -foreground]
433 pack .ctop.top.bar.sha1label -side left
434 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
435 trace add variable sha1string write sha1change
436 pack $sha1entry -side left -pady 2
438 image create bitmap bm-left -data {
439 #define left_width 16
440 #define left_height 16
441 static unsigned char left_bits[] = {
442 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
443 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
444 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
446 image create bitmap bm-right -data {
447 #define right_width 16
448 #define right_height 16
449 static unsigned char right_bits[] = {
450 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
451 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
452 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
454 button .ctop.top.bar.leftbut -image bm-left -command goback \
455 -state disabled -width 26
456 pack .ctop.top.bar.leftbut -side left -fill y
457 button .ctop.top.bar.rightbut -image bm-right -command goforw \
458 -state disabled -width 26
459 pack .ctop.top.bar.rightbut -side left -fill y
461 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
462 pack .ctop.top.bar.findbut -side left
464 set fstring .ctop.top.bar.findstring
465 lappend entries $fstring
466 entry $fstring -width 30 -font $textfont -textvariable findstring -font $textfont
467 pack $fstring -side left -expand 1 -fill x
469 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
470 findtype Exact IgnCase Regexp]
471 .ctop.top.bar.findtype configure -font $uifont
472 .ctop.top.bar.findtype.menu configure -font $uifont
473 set findloc "All fields"
474 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
475 Comments Author Committer Files Pickaxe
476 .ctop.top.bar.findloc configure -font $uifont
477 .ctop.top.bar.findloc.menu configure -font $uifont
479 pack .ctop.top.bar.findloc -side right
480 pack .ctop.top.bar.findtype -side right
481 # for making sure type==Exact whenever loc==Pickaxe
482 trace add variable findloc write findlocchange
484 panedwindow .ctop.cdet -orient horizontal
486 frame .ctop.cdet.left
487 set ctext .ctop.cdet.left.ctext
488 text $ctext -bg white -state disabled -font $textfont \
489 -width $geometry(ctextw) -height $geometry(ctexth) \
490 -yscrollcommand ".ctop.cdet.left.sb set" -wrap none
491 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
492 pack .ctop.cdet.left.sb -side right -fill y
493 pack $ctext -side left -fill both -expand 1
494 .ctop.cdet add .ctop.cdet.left
496 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
497 $ctext tag conf hunksep -fore blue
498 $ctext tag conf d0 -fore red
499 $ctext tag conf d1 -fore "#00a000"
500 $ctext tag conf m0 -fore red
501 $ctext tag conf m1 -fore blue
502 $ctext tag conf m2 -fore green
503 $ctext tag conf m3 -fore purple
504 $ctext tag conf m4 -fore brown
505 $ctext tag conf m5 -fore "#009090"
506 $ctext tag conf m6 -fore magenta
507 $ctext tag conf m7 -fore "#808000"
508 $ctext tag conf m8 -fore "#009000"
509 $ctext tag conf m9 -fore "#ff0080"
510 $ctext tag conf m10 -fore cyan
511 $ctext tag conf m11 -fore "#b07070"
512 $ctext tag conf m12 -fore "#70b0f0"
513 $ctext tag conf m13 -fore "#70f0b0"
514 $ctext tag conf m14 -fore "#f0b070"
515 $ctext tag conf m15 -fore "#ff70b0"
516 $ctext tag conf mmax -fore darkgrey
518 $ctext tag conf mresult -font [concat $textfont bold]
519 $ctext tag conf msep -font [concat $textfont bold]
520 $ctext tag conf found -back yellow
522 frame .ctop.cdet.right
523 set cflist .ctop.cdet.right.cfiles
524 listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \
525 -yscrollcommand ".ctop.cdet.right.sb set" -font $mainfont
526 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
527 pack .ctop.cdet.right.sb -side right -fill y
528 pack $cflist -side left -fill both -expand 1
529 .ctop.cdet add .ctop.cdet.right
530 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
532 pack .ctop -side top -fill both -expand 1
534 bindall <1> {selcanvline %W %x %y}
535 #bindall <B1-Motion> {selcanvline %W %x %y}
536 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
537 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
538 bindall <2> "canvscan mark %W %x %y"
539 bindall <B2-Motion> "canvscan dragto %W %x %y"
540 bindkey <Home> selfirstline
541 bindkey <End> sellastline
542 bind . <Key-Up> "selnextline -1"
543 bind . <Key-Down> "selnextline 1"
544 bindkey <Key-Right> "goforw"
545 bindkey <Key-Left> "goback"
546 bind . <Key-Prior> "selnextpage -1"
547 bind . <Key-Next> "selnextpage 1"
548 bind . <Control-Home> "allcanvs yview moveto 0.0"
549 bind . <Control-End> "allcanvs yview moveto 1.0"
550 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
551 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
552 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
553 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
554 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
555 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
556 bindkey <Key-space> "$ctext yview scroll 1 pages"
557 bindkey p "selnextline -1"
558 bindkey n "selnextline 1"
561 bindkey i "selnextline -1"
562 bindkey k "selnextline 1"
565 bindkey b "$ctext yview scroll -1 pages"
566 bindkey d "$ctext yview scroll 18 units"
567 bindkey u "$ctext yview scroll -18 units"
568 bindkey / {findnext 1}
569 bindkey <Key-Return> {findnext 0}
572 bind . <Control-q> doquit
573 bind . <Control-f> dofind
574 bind . <Control-g> {findnext 0}
575 bind . <Control-r> findprev
576 bind . <Control-equal> {incrfont 1}
577 bind . <Control-KP_Add> {incrfont 1}
578 bind . <Control-minus> {incrfont -1}
579 bind . <Control-KP_Subtract> {incrfont -1}
580 bind $cflist <<ListboxSelect>> listboxsel
581 bind . <Destroy> {savestuff %W}
582 bind . <Button-1> "click %W"
583 bind $fstring <Key-Return> dofind
584 bind $sha1entry <Key-Return> gotocommit
585 bind $sha1entry <<PasteSelection>> clearsha1
587 set maincursor [. cget -cursor]
588 set textcursor [$ctext cget -cursor]
589 set curtextcursor $textcursor
591 set rowctxmenu .rowctxmenu
592 menu $rowctxmenu -tearoff 0
593 $rowctxmenu add command -label "Diff this -> selected" \
594 -command {diffvssel 0}
595 $rowctxmenu add command -label "Diff selected -> this" \
596 -command {diffvssel 1}
597 $rowctxmenu add command -label "Make patch" -command mkpatch
598 $rowctxmenu add command -label "Create tag" -command mktag
599 $rowctxmenu add command -label "Write commit to file" -command writecommit
602 # mouse-2 makes all windows scan vertically, but only the one
603 # the cursor is in scans horizontally
604 proc canvscan {op w x y} {
605 global canv canv2 canv3
606 foreach c [list $canv $canv2 $canv3] {
615 proc scrollcanv {cscroll f0 f1} {
620 # when we make a key binding for the toplevel, make sure
621 # it doesn't get triggered when that key is pressed in the
622 # find string entry widget.
623 proc bindkey {ev script} {
626 set escript [bind Entry $ev]
627 if {$escript == {}} {
628 set escript [bind Entry <Key>]
631 bind $e $ev "$escript; break"
635 # set the focus back to the toplevel for any click outside
646 global canv canv2 canv3 ctext cflist mainfont textfont uifont
647 global stuffsaved findmergefiles maxgraphpct
650 if {$stuffsaved} return
651 if {![winfo viewable .]} return
653 set f [open "~/.gitk-new" w]
654 puts $f [list set mainfont $mainfont]
655 puts $f [list set textfont $textfont]
656 puts $f [list set uifont $uifont]
657 puts $f [list set findmergefiles $findmergefiles]
658 puts $f [list set maxgraphpct $maxgraphpct]
659 puts $f [list set maxwidth $maxwidth]
660 puts $f "set geometry(width) [winfo width .ctop]"
661 puts $f "set geometry(height) [winfo height .ctop]"
662 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
663 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
664 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
665 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
666 set wid [expr {([winfo width $ctext] - 8) \
667 / [font measure $textfont "0"]}]
668 puts $f "set geometry(ctextw) $wid"
669 set wid [expr {([winfo width $cflist] - 11) \
670 / [font measure [$cflist cget -font] "0"]}]
671 puts $f "set geometry(cflistw) $wid"
673 file rename -force "~/.gitk-new" "~/.gitk"
678 proc resizeclistpanes {win w} {
680 if {[info exists oldwidth($win)]} {
681 set s0 [$win sash coord 0]
682 set s1 [$win sash coord 1]
684 set sash0 [expr {int($w/2 - 2)}]
685 set sash1 [expr {int($w*5/6 - 2)}]
687 set factor [expr {1.0 * $w / $oldwidth($win)}]
688 set sash0 [expr {int($factor * [lindex $s0 0])}]
689 set sash1 [expr {int($factor * [lindex $s1 0])}]
693 if {$sash1 < $sash0 + 20} {
694 set sash1 [expr {$sash0 + 20}]
696 if {$sash1 > $w - 10} {
697 set sash1 [expr {$w - 10}]
698 if {$sash0 > $sash1 - 20} {
699 set sash0 [expr {$sash1 - 20}]
703 $win sash place 0 $sash0 [lindex $s0 1]
704 $win sash place 1 $sash1 [lindex $s1 1]
706 set oldwidth($win) $w
709 proc resizecdetpanes {win w} {
711 if {[info exists oldwidth($win)]} {
712 set s0 [$win sash coord 0]
714 set sash0 [expr {int($w*3/4 - 2)}]
716 set factor [expr {1.0 * $w / $oldwidth($win)}]
717 set sash0 [expr {int($factor * [lindex $s0 0])}]
721 if {$sash0 > $w - 15} {
722 set sash0 [expr {$w - 15}]
725 $win sash place 0 $sash0 [lindex $s0 1]
727 set oldwidth($win) $w
731 global canv canv2 canv3
737 proc bindall {event action} {
738 global canv canv2 canv3
739 bind $canv $event $action
740 bind $canv2 $event $action
741 bind $canv3 $event $action
746 if {[winfo exists $w]} {
751 wm title $w "About gitk"
753 Gitk - a commit viewer for git
755 Copyright © 2005-2006 Paul Mackerras
757 Use and redistribute under the terms of the GNU General Public License} \
758 -justify center -aspect 400
759 pack $w.m -side top -fill x -padx 20 -pady 20
760 button $w.ok -text Close -command "destroy $w"
761 pack $w.ok -side bottom
766 if {[winfo exists $w]} {
771 wm title $w "Gitk key bindings"
776 <Home> Move to first commit
777 <End> Move to last commit
778 <Up>, p, i Move up one commit
779 <Down>, n, k Move down one commit
780 <Left>, z, j Go back in history list
781 <Right>, x, l Go forward in history list
782 <PageUp> Move up one page in commit list
783 <PageDown> Move down one page in commit list
784 <Ctrl-Home> Scroll to top of commit list
785 <Ctrl-End> Scroll to bottom of commit list
786 <Ctrl-Up> Scroll commit list up one line
787 <Ctrl-Down> Scroll commit list down one line
788 <Ctrl-PageUp> Scroll commit list up one page
789 <Ctrl-PageDown> Scroll commit list down one page
790 <Delete>, b Scroll diff view up one page
791 <Backspace> Scroll diff view up one page
792 <Space> Scroll diff view down one page
793 u Scroll diff view up 18 lines
794 d Scroll diff view down 18 lines
796 <Ctrl-G> Move to next find hit
797 <Ctrl-R> Move to previous find hit
798 <Return> Move to next find hit
799 / Move to next find hit, or redo find
800 ? Move to previous find hit
801 f Scroll diff view to next file
802 <Ctrl-KP+> Increase font size
803 <Ctrl-plus> Increase font size
804 <Ctrl-KP-> Decrease font size
805 <Ctrl-minus> Decrease font size
807 -justify left -bg white -border 2 -relief sunken
808 pack $w.m -side top -fill both
809 button $w.ok -text Close -command "destroy $w"
810 pack $w.ok -side bottom
814 global newviewname nextviewnum newviewtop
817 if {[winfo exists $top]} {
823 wm title $top "Gitk view definition"
824 label $top.nl -text "Name"
825 entry $top.name -width 20 -textvariable newviewname
826 set newviewname "View $nextviewnum"
827 grid $top.nl $top.name -sticky w
828 label $top.l -text "Files and directories to include:"
829 grid $top.l - -sticky w -pady 10
830 text $top.t -width 30 -height 10
831 grid $top.t - -sticky w
833 button $top.buts.ok -text "OK" -command newviewok
834 button $top.buts.can -text "Cancel" -command newviewcan
835 grid $top.buts.ok $top.buts.can
836 grid columnconfigure $top.buts 0 -weight 1 -uniform a
837 grid columnconfigure $top.buts 1 -weight 1 -uniform a
838 grid $top.buts - -pady 10 -sticky ew
843 global newviewtop nextviewnum
844 global viewname viewfiles
848 set viewname($n) [$newviewtop.name get]
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 command -label $viewname($n) -command [list showview $n]
860 after idle showview $n
866 catch {destroy $newviewtop}
871 global curview viewdata
873 if {$curview == 0} return
874 set nmenu [.bar.view index end]
875 set targetcmd [list showview $curview]
876 for {set i 5} {$i <= $nmenu} {incr i} {
877 if {[.bar.view entrycget $i -command] eq $targetcmd} {
882 set viewdata($curview) {}
887 global curview viewdata viewfiles
888 global displayorder parentlist childlist rowidlist rowoffsets
889 global colormap rowtextx commitrow
890 global numcommits rowrangelist commitlisted idrowranges
891 global selectedline currentid canv canvy0
892 global matchinglines treediffs
894 global pending_select phase
896 if {$n == $curview} return
898 if {[info exists selectedline]} {
900 set y [yc $selectedline]
901 set ymax [lindex [$canv cget -scrollregion] 3]
902 set span [$canv yview]
903 set ytop [expr {[lindex $span 0] * $ymax}]
904 set ybot [expr {[lindex $span 1] * $ymax}]
905 if {$ytop < $y && $y < $ybot} {
906 set yscreen [expr {$y - $ytop}]
908 set yscreen [expr {($ybot - $ytop) / 2}]
914 if {$curview >= 0 && $phase eq {} && ![info exists viewdata($curview)]} {
915 set viewdata($curview) \
916 [list $displayorder $parentlist $childlist $rowidlist \
917 $rowoffsets $rowrangelist $commitlisted]
919 catch {unset matchinglines}
920 catch {unset treediffs}
924 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
926 if {![info exists viewdata($n)]} {
927 set args $parsed_args
928 if {$viewfiles($n) ne {}} {
929 set args [concat $args "--" $viewfiles($n)]
931 set pending_select $selid
936 set displayorder [lindex $viewdata($n) 0]
937 set parentlist [lindex $viewdata($n) 1]
938 set childlist [lindex $viewdata($n) 2]
939 set rowidlist [lindex $viewdata($n) 3]
940 set rowoffsets [lindex $viewdata($n) 4]
941 set rowrangelist [lindex $viewdata($n) 5]
942 set commitlisted [lindex $viewdata($n) 6]
943 set numcommits [llength $displayorder]
944 catch {unset colormap}
945 catch {unset rowtextx}
946 catch {unset commitrow}
947 catch {unset idrowranges}
950 foreach id $displayorder {
951 set commitrow($id) $row
957 if {$selid ne {} && [info exists commitrow($selid)]} {
958 set row $commitrow($selid)
959 # try to get the selected row in the same position on the screen
960 set ymax [lindex [$canv cget -scrollregion] 3]
961 set ytop [expr {[yc $row] - $yscreen}]
965 set yf [expr {$ytop * 1.0 / $ymax}]
967 allcanvs yview moveto $yf
972 proc shortids {ids} {
975 if {[llength $id] > 1} {
976 lappend res [shortids $id]
977 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
978 lappend res [string range $id 0 7]
986 proc incrange {l x o} {
991 lset l $x [expr {$e + $o}]
1000 for {} {$n > 0} {incr n -1} {
1006 proc usedinrange {id l1 l2} {
1007 global children commitrow
1009 if {[info exists commitrow($id)]} {
1010 set r $commitrow($id)
1011 if {$l1 <= $r && $r <= $l2} {
1012 return [expr {$r - $l1 + 1}]
1015 foreach c $children($id) {
1016 if {[info exists commitrow($c)]} {
1017 set r $commitrow($c)
1018 if {$l1 <= $r && $r <= $l2} {
1019 return [expr {$r - $l1 + 1}]
1026 proc sanity {row {full 0}} {
1027 global rowidlist rowoffsets
1030 set ids [lindex $rowidlist $row]
1033 if {$id eq {}} continue
1034 if {$col < [llength $ids] - 1 &&
1035 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1036 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1038 set o [lindex $rowoffsets $row $col]
1044 if {[lindex $rowidlist $y $x] != $id} {
1045 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1046 puts " id=[shortids $id] check started at row $row"
1047 for {set i $row} {$i >= $y} {incr i -1} {
1048 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1053 set o [lindex $rowoffsets $y $x]
1058 proc makeuparrow {oid x y z} {
1059 global rowidlist rowoffsets uparrowlen idrowranges
1061 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1064 set off0 [lindex $rowoffsets $y]
1065 for {set x0 $x} {1} {incr x0} {
1066 if {$x0 >= [llength $off0]} {
1067 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1070 set z [lindex $off0 $x0]
1076 set z [expr {$x0 - $x}]
1077 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1078 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1080 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1081 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1082 lappend idrowranges($oid) $y
1085 proc initlayout {} {
1086 global rowidlist rowoffsets displayorder commitlisted
1087 global rowlaidout rowoptim
1088 global idinlist rowchk rowrangelist idrowranges
1089 global commitidx numcommits canvxmax canv
1091 global parentlist childlist children
1092 global colormap rowtextx commitrow
1102 catch {unset children}
1106 catch {unset idinlist}
1107 catch {unset rowchk}
1110 set canvxmax [$canv cget -width]
1111 catch {unset colormap}
1112 catch {unset rowtextx}
1113 catch {unset commitrow}
1114 catch {unset idrowranges}
1115 catch {unset linesegends}
1118 proc setcanvscroll {} {
1119 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1121 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1122 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1123 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1124 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1127 proc visiblerows {} {
1128 global canv numcommits linespc
1130 set ymax [lindex [$canv cget -scrollregion] 3]
1131 if {$ymax eq {} || $ymax == 0} return
1133 set y0 [expr {int([lindex $f 0] * $ymax)}]
1134 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1138 set y1 [expr {int([lindex $f 1] * $ymax)}]
1139 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1140 if {$r1 >= $numcommits} {
1141 set r1 [expr {$numcommits - 1}]
1143 return [list $r0 $r1]
1146 proc layoutmore {} {
1147 global rowlaidout rowoptim commitidx numcommits optim_delay
1151 set rowlaidout [layoutrows $row $commitidx 0]
1152 set orow [expr {$rowlaidout - $uparrowlen - 1}]
1153 if {$orow > $rowoptim} {
1154 optimize_rows $rowoptim 0 $orow
1157 set canshow [expr {$rowoptim - $optim_delay}]
1158 if {$canshow > $numcommits} {
1163 proc showstuff {canshow} {
1164 global numcommits commitrow pending_select selectedline
1165 global linesegends idrowranges idrangedrawn
1167 if {$numcommits == 0} {
1169 set phase "incrdraw"
1173 set numcommits $canshow
1175 set rows [visiblerows]
1176 set r0 [lindex $rows 0]
1177 set r1 [lindex $rows 1]
1179 for {set r $row} {$r < $canshow} {incr r} {
1180 if {[info exists linesegends($r)]} {
1181 foreach id $linesegends($r) {
1183 foreach {s e} $idrowranges($id) {
1185 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
1186 && ![info exists idrangedrawn($id,$i)]} {
1188 set idrangedrawn($id,$i) 1
1194 if {$canshow > $r1} {
1197 while {$row < $canshow} {
1201 if {[info exists pending_select] &&
1202 [info exists commitrow($pending_select)] &&
1203 $commitrow($pending_select) < $numcommits} {
1204 selectline $commitrow($pending_select) 1
1206 if {![info exists selectedline] && ![info exists pending_select]} {
1211 proc layoutrows {row endrow last} {
1212 global rowidlist rowoffsets displayorder
1213 global uparrowlen downarrowlen maxwidth mingaplen
1214 global childlist parentlist
1215 global idrowranges linesegends
1217 global idinlist rowchk rowrangelist
1219 set idlist [lindex $rowidlist $row]
1220 set offs [lindex $rowoffsets $row]
1221 while {$row < $endrow} {
1222 set id [lindex $displayorder $row]
1225 foreach p [lindex $parentlist $row] {
1226 if {![info exists idinlist($p)]} {
1228 } elseif {!$idinlist($p)} {
1232 set nev [expr {[llength $idlist] + [llength $newolds]
1233 + [llength $oldolds] - $maxwidth + 1}]
1235 if {!$last && $row + $uparrowlen + $mingaplen >= $commitidx} break
1236 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
1237 set i [lindex $idlist $x]
1238 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
1239 set r [usedinrange $i [expr {$row - $downarrowlen}] \
1240 [expr {$row + $uparrowlen + $mingaplen}]]
1242 set idlist [lreplace $idlist $x $x]
1243 set offs [lreplace $offs $x $x]
1244 set offs [incrange $offs $x 1]
1246 set rm1 [expr {$row - 1}]
1247 lappend linesegends($rm1) $i
1248 lappend idrowranges($i) $rm1
1249 if {[incr nev -1] <= 0} break
1252 set rowchk($id) [expr {$row + $r}]
1255 lset rowidlist $row $idlist
1256 lset rowoffsets $row $offs
1258 set col [lsearch -exact $idlist $id]
1260 set col [llength $idlist]
1262 lset rowidlist $row $idlist
1264 if {[lindex $childlist $row] ne {}} {
1265 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
1269 lset rowoffsets $row $offs
1271 makeuparrow $id $col $row $z
1277 if {[info exists idrowranges($id)]} {
1278 lappend idrowranges($id) $row
1279 set ranges $idrowranges($id)
1281 lappend rowrangelist $ranges
1283 set offs [ntimes [llength $idlist] 0]
1284 set l [llength $newolds]
1285 set idlist [eval lreplace \$idlist $col $col $newolds]
1288 set offs [lrange $offs 0 [expr {$col - 1}]]
1289 foreach x $newolds {
1294 set tmp [expr {[llength $idlist] - [llength $offs]}]
1296 set offs [concat $offs [ntimes $tmp $o]]
1301 foreach i $newolds {
1303 set idrowranges($i) $row
1306 foreach oid $oldolds {
1307 set idinlist($oid) 1
1308 set idlist [linsert $idlist $col $oid]
1309 set offs [linsert $offs $col $o]
1310 makeuparrow $oid $col $row $o
1313 lappend rowidlist $idlist
1314 lappend rowoffsets $offs
1319 proc addextraid {id row} {
1320 global displayorder commitrow commitinfo
1322 global parentlist childlist children
1325 lappend displayorder $id
1326 lappend parentlist {}
1327 set commitrow($id) $row
1329 if {![info exists commitinfo($id)]} {
1330 set commitinfo($id) {"No commit information available"}
1332 if {[info exists children($id)]} {
1333 lappend childlist $children($id)
1335 lappend childlist {}
1339 proc layouttail {} {
1340 global rowidlist rowoffsets idinlist commitidx
1341 global idrowranges rowrangelist
1344 set idlist [lindex $rowidlist $row]
1345 while {$idlist ne {}} {
1346 set col [expr {[llength $idlist] - 1}]
1347 set id [lindex $idlist $col]
1350 lappend idrowranges($id) $row
1351 lappend rowrangelist $idrowranges($id)
1353 set offs [ntimes $col 0]
1354 set idlist [lreplace $idlist $col $col]
1355 lappend rowidlist $idlist
1356 lappend rowoffsets $offs
1359 foreach id [array names idinlist] {
1361 lset rowidlist $row [list $id]
1362 lset rowoffsets $row 0
1363 makeuparrow $id 0 $row 0
1364 lappend idrowranges($id) $row
1365 lappend rowrangelist $idrowranges($id)
1367 lappend rowidlist {}
1368 lappend rowoffsets {}
1372 proc insert_pad {row col npad} {
1373 global rowidlist rowoffsets
1375 set pad [ntimes $npad {}]
1376 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
1377 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
1378 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
1381 proc optimize_rows {row col endrow} {
1382 global rowidlist rowoffsets idrowranges displayorder
1384 for {} {$row < $endrow} {incr row} {
1385 set idlist [lindex $rowidlist $row]
1386 set offs [lindex $rowoffsets $row]
1388 for {} {$col < [llength $offs]} {incr col} {
1389 if {[lindex $idlist $col] eq {}} {
1393 set z [lindex $offs $col]
1394 if {$z eq {}} continue
1396 set x0 [expr {$col + $z}]
1397 set y0 [expr {$row - 1}]
1398 set z0 [lindex $rowoffsets $y0 $x0]
1400 set id [lindex $idlist $col]
1401 if {[info exists idrowranges($id)] &&
1402 $y0 > [lindex $idrowranges($id) 0]} {
1406 if {$z < -1 || ($z < 0 && $isarrow)} {
1407 set npad [expr {-1 - $z + $isarrow}]
1408 set offs [incrange $offs $col $npad]
1409 insert_pad $y0 $x0 $npad
1411 optimize_rows $y0 $x0 $row
1413 set z [lindex $offs $col]
1414 set x0 [expr {$col + $z}]
1415 set z0 [lindex $rowoffsets $y0 $x0]
1416 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
1417 set npad [expr {$z - 1 + $isarrow}]
1418 set y1 [expr {$row + 1}]
1419 set offs2 [lindex $rowoffsets $y1]
1423 if {$z eq {} || $x1 + $z < $col} continue
1424 if {$x1 + $z > $col} {
1427 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
1430 set pad [ntimes $npad {}]
1431 set idlist [eval linsert \$idlist $col $pad]
1432 set tmp [eval linsert \$offs $col $pad]
1434 set offs [incrange $tmp $col [expr {-$npad}]]
1435 set z [lindex $offs $col]
1438 if {$z0 eq {} && !$isarrow} {
1439 # this line links to its first child on row $row-2
1440 set rm2 [expr {$row - 2}]
1441 set id [lindex $displayorder $rm2]
1442 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
1444 set z0 [expr {$xc - $x0}]
1447 if {$z0 ne {} && $z < 0 && $z0 > 0} {
1448 insert_pad $y0 $x0 1
1449 set offs [incrange $offs $col 1]
1450 optimize_rows $y0 [expr {$x0 + 1}] $row
1455 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
1456 set o [lindex $offs $col]
1458 # check if this is the link to the first child
1459 set id [lindex $idlist $col]
1460 if {[info exists idrowranges($id)] &&
1461 $row == [lindex $idrowranges($id) 0]} {
1462 # it is, work out offset to child
1463 set y0 [expr {$row - 1}]
1464 set id [lindex $displayorder $y0]
1465 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
1467 set o [expr {$x0 - $col}]
1471 if {$o eq {} || $o <= 0} break
1473 if {$o ne {} && [incr col] < [llength $idlist]} {
1474 set y1 [expr {$row + 1}]
1475 set offs2 [lindex $rowoffsets $y1]
1479 if {$z eq {} || $x1 + $z < $col} continue
1480 lset rowoffsets $y1 [incrange $offs2 $x1 1]
1483 set idlist [linsert $idlist $col {}]
1484 set tmp [linsert $offs $col {}]
1486 set offs [incrange $tmp $col -1]
1489 lset rowidlist $row $idlist
1490 lset rowoffsets $row $offs
1496 global canvx0 linespc
1497 return [expr {$canvx0 + $col * $linespc}]
1501 global canvy0 linespc
1502 return [expr {$canvy0 + $row * $linespc}]
1505 proc linewidth {id} {
1506 global thickerline lthickness
1509 if {[info exists thickerline] && $id eq $thickerline} {
1510 set wid [expr {2 * $lthickness}]
1515 proc rowranges {id} {
1516 global idrowranges commitrow numcommits rowrangelist
1519 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1520 set ranges [lindex $rowrangelist $commitrow($id)]
1521 } elseif {[info exists idrowranges($id)]} {
1522 set ranges $idrowranges($id)
1527 proc drawlineseg {id i} {
1528 global rowoffsets rowidlist
1530 global canv colormap linespc
1531 global numcommits commitrow
1533 set ranges [rowranges $id]
1535 if {[info exists commitrow($id)] && $commitrow($id) < $numcommits} {
1536 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
1540 set startrow [lindex $ranges [expr {2 * $i}]]
1541 set row [lindex $ranges [expr {2 * $i + 1}]]
1542 if {$startrow == $row} return
1545 set col [lsearch -exact [lindex $rowidlist $row] $id]
1547 puts "oops: drawline: id $id not on row $row"
1553 set o [lindex $rowoffsets $row $col]
1556 # changing direction
1557 set x [xc $row $col]
1559 lappend coords $x $y
1565 set x [xc $row $col]
1567 lappend coords $x $y
1569 # draw the link to the first child as part of this line
1571 set child [lindex $displayorder $row]
1572 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
1574 set x [xc $row $ccol]
1576 if {$ccol < $col - 1} {
1577 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
1578 } elseif {$ccol > $col + 1} {
1579 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
1581 lappend coords $x $y
1584 if {[llength $coords] < 4} return
1586 # This line has an arrow at the lower end: check if the arrow is
1587 # on a diagonal segment, and if so, work around the Tk 8.4
1588 # refusal to draw arrows on diagonal lines.
1589 set x0 [lindex $coords 0]
1590 set x1 [lindex $coords 2]
1592 set y0 [lindex $coords 1]
1593 set y1 [lindex $coords 3]
1594 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
1595 # we have a nearby vertical segment, just trim off the diag bit
1596 set coords [lrange $coords 2 end]
1598 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
1599 set xi [expr {$x0 - $slope * $linespc / 2}]
1600 set yi [expr {$y0 - $linespc / 2}]
1601 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
1605 set arrow [expr {2 * ($i > 0) + $downarrow}]
1606 set arrow [lindex {none first last both} $arrow]
1607 set t [$canv create line $coords -width [linewidth $id] \
1608 -fill $colormap($id) -tags lines.$id -arrow $arrow]
1613 proc drawparentlinks {id row col olds} {
1614 global rowidlist canv colormap
1616 set row2 [expr {$row + 1}]
1617 set x [xc $row $col]
1620 set ids [lindex $rowidlist $row2]
1621 # rmx = right-most X coord used
1624 set i [lsearch -exact $ids $p]
1626 puts "oops, parent $p of $id not in list"
1629 set x2 [xc $row2 $i]
1633 set ranges [rowranges $p]
1634 if {$ranges ne {} && $row2 == [lindex $ranges 0]
1635 && $row2 < [lindex $ranges 1]} {
1636 # drawlineseg will do this one for us
1640 # should handle duplicated parents here...
1641 set coords [list $x $y]
1642 if {$i < $col - 1} {
1643 lappend coords [xc $row [expr {$i + 1}]] $y
1644 } elseif {$i > $col + 1} {
1645 lappend coords [xc $row [expr {$i - 1}]] $y
1647 lappend coords $x2 $y2
1648 set t [$canv create line $coords -width [linewidth $p] \
1649 -fill $colormap($p) -tags lines.$p]
1656 proc drawlines {id} {
1657 global colormap canv
1659 global childlist iddrawn commitrow rowidlist
1661 $canv delete lines.$id
1662 set nr [expr {[llength [rowranges $id]] / 2}]
1663 for {set i 0} {$i < $nr} {incr i} {
1664 if {[info exists idrangedrawn($id,$i)]} {
1668 foreach child [lindex $childlist $commitrow($id)] {
1669 if {[info exists iddrawn($child)]} {
1670 set row $commitrow($child)
1671 set col [lsearch -exact [lindex $rowidlist $row] $child]
1673 drawparentlinks $child $row $col [list $id]
1679 proc drawcmittext {id row col rmx} {
1680 global linespc canv canv2 canv3 canvy0
1681 global commitlisted commitinfo rowidlist
1682 global rowtextx idpos idtags idheads idotherrefs
1683 global linehtag linentag linedtag
1684 global mainfont namefont canvxmax
1686 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
1687 set x [xc $row $col]
1689 set orad [expr {$linespc / 3}]
1690 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
1691 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
1692 -fill $ofill -outline black -width 1]
1694 $canv bind $t <1> {selcanvline {} %x %y}
1695 set xt [xc $row [llength [lindex $rowidlist $row]]]
1699 set rowtextx($row) $xt
1700 set idpos($id) [list $x $xt $y]
1701 if {[info exists idtags($id)] || [info exists idheads($id)]
1702 || [info exists idotherrefs($id)]} {
1703 set xt [drawtags $id $x $xt $y]
1705 set headline [lindex $commitinfo($id) 0]
1706 set name [lindex $commitinfo($id) 1]
1707 set date [lindex $commitinfo($id) 2]
1708 set date [formatdate $date]
1709 set linehtag($row) [$canv create text $xt $y -anchor w \
1710 -text $headline -font $mainfont ]
1711 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
1712 set linentag($row) [$canv2 create text 3 $y -anchor w \
1713 -text $name -font $namefont]
1714 set linedtag($row) [$canv3 create text 3 $y -anchor w \
1715 -text $date -font $mainfont]
1716 set xr [expr {$xt + [font measure $mainfont $headline]}]
1717 if {$xr > $canvxmax} {
1723 proc drawcmitrow {row} {
1724 global displayorder rowidlist
1725 global idrangedrawn iddrawn
1726 global commitinfo commitlisted parentlist numcommits
1728 if {$row >= $numcommits} return
1729 foreach id [lindex $rowidlist $row] {
1731 foreach {s e} [rowranges $id] {
1733 if {$row < $s} continue
1736 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
1738 set idrangedrawn($id,$i) 1
1745 set id [lindex $displayorder $row]
1746 if {[info exists iddrawn($id)]} return
1747 set col [lsearch -exact [lindex $rowidlist $row] $id]
1749 puts "oops, row $row id $id not in list"
1752 if {![info exists commitinfo($id)]} {
1756 set olds [lindex $parentlist $row]
1758 set rmx [drawparentlinks $id $row $col $olds]
1762 drawcmittext $id $row $col $rmx
1766 proc drawfrac {f0 f1} {
1767 global numcommits canv
1770 set ymax [lindex [$canv cget -scrollregion] 3]
1771 if {$ymax eq {} || $ymax == 0} return
1772 set y0 [expr {int($f0 * $ymax)}]
1773 set row [expr {int(($y0 - 3) / $linespc) - 1}]
1777 set y1 [expr {int($f1 * $ymax)}]
1778 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
1779 if {$endrow >= $numcommits} {
1780 set endrow [expr {$numcommits - 1}]
1782 for {} {$row <= $endrow} {incr row} {
1787 proc drawvisible {} {
1789 eval drawfrac [$canv yview]
1792 proc clear_display {} {
1793 global iddrawn idrangedrawn
1796 catch {unset iddrawn}
1797 catch {unset idrangedrawn}
1800 proc findcrossings {id} {
1801 global rowidlist parentlist numcommits rowoffsets displayorder
1805 foreach {s e} [rowranges $id] {
1806 if {$e >= $numcommits} {
1807 set e [expr {$numcommits - 1}]
1809 if {$e <= $s} continue
1810 set x [lsearch -exact [lindex $rowidlist $e] $id]
1812 puts "findcrossings: oops, no [shortids $id] in row $e"
1815 for {set row $e} {[incr row -1] >= $s} {} {
1816 set olds [lindex $parentlist $row]
1817 set kid [lindex $displayorder $row]
1818 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
1819 if {$kidx < 0} continue
1820 set nextrow [lindex $rowidlist [expr {$row + 1}]]
1822 set px [lsearch -exact $nextrow $p]
1823 if {$px < 0} continue
1824 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
1825 if {[lsearch -exact $ccross $p] >= 0} continue
1826 if {$x == $px + ($kidx < $px? -1: 1)} {
1828 } elseif {[lsearch -exact $cross $p] < 0} {
1833 set inc [lindex $rowoffsets $row $x]
1834 if {$inc eq {}} break
1838 return [concat $ccross {{}} $cross]
1841 proc assigncolor {id} {
1842 global colormap colors nextcolor
1843 global commitrow parentlist children childlist
1845 if {[info exists colormap($id)]} return
1846 set ncolors [llength $colors]
1847 if {[info exists commitrow($id)]} {
1848 set kids [lindex $childlist $commitrow($id)]
1849 } elseif {[info exists children($id)]} {
1850 set kids $children($id)
1854 if {[llength $kids] == 1} {
1855 set child [lindex $kids 0]
1856 if {[info exists colormap($child)]
1857 && [llength [lindex $parentlist $commitrow($child)]] == 1} {
1858 set colormap($id) $colormap($child)
1864 foreach x [findcrossings $id] {
1866 # delimiter between corner crossings and other crossings
1867 if {[llength $badcolors] >= $ncolors - 1} break
1868 set origbad $badcolors
1870 if {[info exists colormap($x)]
1871 && [lsearch -exact $badcolors $colormap($x)] < 0} {
1872 lappend badcolors $colormap($x)
1875 if {[llength $badcolors] >= $ncolors} {
1876 set badcolors $origbad
1878 set origbad $badcolors
1879 if {[llength $badcolors] < $ncolors - 1} {
1880 foreach child $kids {
1881 if {[info exists colormap($child)]
1882 && [lsearch -exact $badcolors $colormap($child)] < 0} {
1883 lappend badcolors $colormap($child)
1885 foreach p [lindex $parentlist $commitrow($child)] {
1886 if {[info exists colormap($p)]
1887 && [lsearch -exact $badcolors $colormap($p)] < 0} {
1888 lappend badcolors $colormap($p)
1892 if {[llength $badcolors] >= $ncolors} {
1893 set badcolors $origbad
1896 for {set i 0} {$i <= $ncolors} {incr i} {
1897 set c [lindex $colors $nextcolor]
1898 if {[incr nextcolor] >= $ncolors} {
1901 if {[lsearch -exact $badcolors $c]} break
1903 set colormap($id) $c
1906 proc bindline {t id} {
1909 $canv bind $t <Enter> "lineenter %x %y $id"
1910 $canv bind $t <Motion> "linemotion %x %y $id"
1911 $canv bind $t <Leave> "lineleave $id"
1912 $canv bind $t <Button-1> "lineclick %x %y $id 1"
1915 proc drawtags {id x xt y1} {
1916 global idtags idheads idotherrefs
1917 global linespc lthickness
1918 global canv mainfont commitrow rowtextx
1923 if {[info exists idtags($id)]} {
1924 set marks $idtags($id)
1925 set ntags [llength $marks]
1927 if {[info exists idheads($id)]} {
1928 set marks [concat $marks $idheads($id)]
1929 set nheads [llength $idheads($id)]
1931 if {[info exists idotherrefs($id)]} {
1932 set marks [concat $marks $idotherrefs($id)]
1938 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
1939 set yt [expr {$y1 - 0.5 * $linespc}]
1940 set yb [expr {$yt + $linespc - 1}]
1943 foreach tag $marks {
1944 set wid [font measure $mainfont $tag]
1947 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
1949 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
1950 -width $lthickness -fill black -tags tag.$id]
1952 foreach tag $marks x $xvals wid $wvals {
1953 set xl [expr {$x + $delta}]
1954 set xr [expr {$x + $delta + $wid + $lthickness}]
1955 if {[incr ntags -1] >= 0} {
1957 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
1958 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
1959 -width 1 -outline black -fill yellow -tags tag.$id]
1960 $canv bind $t <1> [list showtag $tag 1]
1961 set rowtextx($commitrow($id)) [expr {$xr + $linespc}]
1963 # draw a head or other ref
1964 if {[incr nheads -1] >= 0} {
1969 set xl [expr {$xl - $delta/2}]
1970 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
1971 -width 1 -outline black -fill $col -tags tag.$id
1973 set t [$canv create text $xl $y1 -anchor w -text $tag \
1974 -font $mainfont -tags tag.$id]
1976 $canv bind $t <1> [list showtag $tag 1]
1982 proc xcoord {i level ln} {
1983 global canvx0 xspc1 xspc2
1985 set x [expr {$canvx0 + $i * $xspc1($ln)}]
1986 if {$i > 0 && $i == $level} {
1987 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
1988 } elseif {$i > $level} {
1989 set x [expr {$x + $xspc2 - $xspc1($ln)}]
1994 proc finishcommits {} {
1995 global commitidx phase
1996 global canv mainfont ctext maincursor textcursor
1997 global findinprogress pending_select
1999 if {$commitidx > 0} {
2003 $canv create text 3 3 -anchor nw -text "No commits selected" \
2004 -font $mainfont -tags textitems
2006 if {![info exists findinprogress]} {
2007 . config -cursor $maincursor
2008 settextcursor $textcursor
2011 catch {unset pending_select}
2014 # Don't change the text pane cursor if it is currently the hand cursor,
2015 # showing that we are over a sha1 ID link.
2016 proc settextcursor {c} {
2017 global ctext curtextcursor
2019 if {[$ctext cget -cursor] == $curtextcursor} {
2020 $ctext config -cursor $c
2022 set curtextcursor $c
2028 global canvy0 numcommits linespc
2029 global rowlaidout commitidx
2030 global pending_select
2033 layoutrows $rowlaidout $commitidx 1
2035 optimize_rows $row 0 $commitidx
2036 showstuff $commitidx
2037 if {[info exists pending_select]} {
2041 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2042 #puts "overall $drawmsecs ms for $numcommits commits"
2045 proc findmatches {f} {
2046 global findtype foundstring foundstrlen
2047 if {$findtype == "Regexp"} {
2048 set matches [regexp -indices -all -inline $foundstring $f]
2050 if {$findtype == "IgnCase"} {
2051 set str [string tolower $f]
2057 while {[set j [string first $foundstring $str $i]] >= 0} {
2058 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2059 set i [expr {$j + $foundstrlen}]
2066 global findtype findloc findstring markedmatches commitinfo
2067 global numcommits displayorder linehtag linentag linedtag
2068 global mainfont namefont canv canv2 canv3 selectedline
2069 global matchinglines foundstring foundstrlen matchstring
2075 set matchinglines {}
2076 if {$findloc == "Pickaxe"} {
2080 if {$findtype == "IgnCase"} {
2081 set foundstring [string tolower $findstring]
2083 set foundstring $findstring
2085 set foundstrlen [string length $findstring]
2086 if {$foundstrlen == 0} return
2087 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
2088 set matchstring "*$matchstring*"
2089 if {$findloc == "Files"} {
2093 if {![info exists selectedline]} {
2096 set oldsel $selectedline
2099 set fldtypes {Headline Author Date Committer CDate Comment}
2101 foreach id $displayorder {
2102 set d $commitdata($id)
2104 if {$findtype == "Regexp"} {
2105 set doesmatch [regexp $foundstring $d]
2106 } elseif {$findtype == "IgnCase"} {
2107 set doesmatch [string match -nocase $matchstring $d]
2109 set doesmatch [string match $matchstring $d]
2111 if {!$doesmatch} continue
2112 if {![info exists commitinfo($id)]} {
2115 set info $commitinfo($id)
2117 foreach f $info ty $fldtypes {
2118 if {$findloc != "All fields" && $findloc != $ty} {
2121 set matches [findmatches $f]
2122 if {$matches == {}} continue
2124 if {$ty == "Headline"} {
2126 markmatches $canv $l $f $linehtag($l) $matches $mainfont
2127 } elseif {$ty == "Author"} {
2129 markmatches $canv2 $l $f $linentag($l) $matches $namefont
2130 } elseif {$ty == "Date"} {
2132 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
2136 lappend matchinglines $l
2137 if {!$didsel && $l > $oldsel} {
2143 if {$matchinglines == {}} {
2145 } elseif {!$didsel} {
2146 findselectline [lindex $matchinglines 0]
2150 proc findselectline {l} {
2151 global findloc commentend ctext
2153 if {$findloc == "All fields" || $findloc == "Comments"} {
2154 # highlight the matches in the comments
2155 set f [$ctext get 1.0 $commentend]
2156 set matches [findmatches $f]
2157 foreach match $matches {
2158 set start [lindex $match 0]
2159 set end [expr {[lindex $match 1] + 1}]
2160 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
2165 proc findnext {restart} {
2166 global matchinglines selectedline
2167 if {![info exists matchinglines]} {
2173 if {![info exists selectedline]} return
2174 foreach l $matchinglines {
2175 if {$l > $selectedline} {
2184 global matchinglines selectedline
2185 if {![info exists matchinglines]} {
2189 if {![info exists selectedline]} return
2191 foreach l $matchinglines {
2192 if {$l >= $selectedline} break
2196 findselectline $prev
2202 proc findlocchange {name ix op} {
2203 global findloc findtype findtypemenu
2204 if {$findloc == "Pickaxe"} {
2210 $findtypemenu entryconf 1 -state $state
2211 $findtypemenu entryconf 2 -state $state
2214 proc stopfindproc {{done 0}} {
2215 global findprocpid findprocfile findids
2216 global ctext findoldcursor phase maincursor textcursor
2217 global findinprogress
2219 catch {unset findids}
2220 if {[info exists findprocpid]} {
2222 catch {exec kill $findprocpid}
2224 catch {close $findprocfile}
2227 if {[info exists findinprogress]} {
2228 unset findinprogress
2229 if {$phase != "incrdraw"} {
2230 . config -cursor $maincursor
2231 settextcursor $textcursor
2236 proc findpatches {} {
2237 global findstring selectedline numcommits
2238 global findprocpid findprocfile
2239 global finddidsel ctext displayorder findinprogress
2240 global findinsertpos
2242 if {$numcommits == 0} return
2244 # make a list of all the ids to search, starting at the one
2245 # after the selected line (if any)
2246 if {[info exists selectedline]} {
2252 for {set i 0} {$i < $numcommits} {incr i} {
2253 if {[incr l] >= $numcommits} {
2256 append inputids [lindex $displayorder $l] "\n"
2260 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
2263 error_popup "Error starting search process: $err"
2267 set findinsertpos end
2269 set findprocpid [pid $f]
2270 fconfigure $f -blocking 0
2271 fileevent $f readable readfindproc
2273 . config -cursor watch
2275 set findinprogress 1
2278 proc readfindproc {} {
2279 global findprocfile finddidsel
2280 global commitrow matchinglines findinsertpos
2282 set n [gets $findprocfile line]
2284 if {[eof $findprocfile]} {
2292 if {![regexp {^[0-9a-f]{40}} $line id]} {
2293 error_popup "Can't parse git-diff-tree output: $line"
2297 if {![info exists commitrow($id)]} {
2298 puts stderr "spurious id: $id"
2301 set l $commitrow($id)
2305 proc insertmatch {l id} {
2306 global matchinglines findinsertpos finddidsel
2308 if {$findinsertpos == "end"} {
2309 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
2310 set matchinglines [linsert $matchinglines 0 $l]
2313 lappend matchinglines $l
2316 set matchinglines [linsert $matchinglines $findinsertpos $l]
2327 global selectedline numcommits displayorder ctext
2328 global ffileline finddidsel parentlist
2329 global findinprogress findstartline findinsertpos
2330 global treediffs fdiffid fdiffsneeded fdiffpos
2331 global findmergefiles
2333 if {$numcommits == 0} return
2335 if {[info exists selectedline]} {
2336 set l [expr {$selectedline + 1}]
2341 set findstartline $l
2345 set id [lindex $displayorder $l]
2346 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2347 if {![info exists treediffs($id)]} {
2348 append diffsneeded "$id\n"
2349 lappend fdiffsneeded $id
2352 if {[incr l] >= $numcommits} {
2355 if {$l == $findstartline} break
2358 # start off a git-diff-tree process if needed
2359 if {$diffsneeded ne {}} {
2361 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
2363 error_popup "Error starting search process: $err"
2366 catch {unset fdiffid}
2368 fconfigure $df -blocking 0
2369 fileevent $df readable [list readfilediffs $df]
2373 set findinsertpos end
2374 set id [lindex $displayorder $l]
2375 . config -cursor watch
2377 set findinprogress 1
2382 proc readfilediffs {df} {
2383 global findid fdiffid fdiffs
2385 set n [gets $df line]
2389 if {[catch {close $df} err]} {
2392 error_popup "Error in git-diff-tree: $err"
2393 } elseif {[info exists findid]} {
2397 error_popup "Couldn't find diffs for $id"
2402 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
2403 # start of a new string of diffs
2407 } elseif {[string match ":*" $line]} {
2408 lappend fdiffs [lindex $line 5]
2412 proc donefilediff {} {
2413 global fdiffid fdiffs treediffs findid
2414 global fdiffsneeded fdiffpos
2416 if {[info exists fdiffid]} {
2417 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
2418 && $fdiffpos < [llength $fdiffsneeded]} {
2419 # git-diff-tree doesn't output anything for a commit
2420 # which doesn't change anything
2421 set nullid [lindex $fdiffsneeded $fdiffpos]
2422 set treediffs($nullid) {}
2423 if {[info exists findid] && $nullid eq $findid} {
2431 if {![info exists treediffs($fdiffid)]} {
2432 set treediffs($fdiffid) $fdiffs
2434 if {[info exists findid] && $fdiffid eq $findid} {
2442 global findid treediffs parentlist
2443 global ffileline findstartline finddidsel
2444 global displayorder numcommits matchinglines findinprogress
2445 global findmergefiles
2449 set id [lindex $displayorder $l]
2450 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
2451 if {![info exists treediffs($id)]} {
2457 foreach f $treediffs($id) {
2458 set x [findmatches $f]
2468 if {[incr l] >= $numcommits} {
2471 if {$l == $findstartline} break
2479 # mark a commit as matching by putting a yellow background
2480 # behind the headline
2481 proc markheadline {l id} {
2482 global canv mainfont linehtag
2485 set bbox [$canv bbox $linehtag($l)]
2486 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
2490 # mark the bits of a headline, author or date that match a find string
2491 proc markmatches {canv l str tag matches font} {
2492 set bbox [$canv bbox $tag]
2493 set x0 [lindex $bbox 0]
2494 set y0 [lindex $bbox 1]
2495 set y1 [lindex $bbox 3]
2496 foreach match $matches {
2497 set start [lindex $match 0]
2498 set end [lindex $match 1]
2499 if {$start > $end} continue
2500 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
2501 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
2502 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
2503 [expr {$x0+$xlen+2}] $y1 \
2504 -outline {} -tags matches -fill yellow]
2509 proc unmarkmatches {} {
2510 global matchinglines findids
2511 allcanvs delete matches
2512 catch {unset matchinglines}
2513 catch {unset findids}
2516 proc selcanvline {w x y} {
2517 global canv canvy0 ctext linespc
2519 set ymax [lindex [$canv cget -scrollregion] 3]
2520 if {$ymax == {}} return
2521 set yfrac [lindex [$canv yview] 0]
2522 set y [expr {$y + $yfrac * $ymax}]
2523 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
2528 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
2534 proc commit_descriptor {p} {
2537 if {[info exists commitinfo($p)]} {
2538 set l [lindex $commitinfo($p) 0]
2543 # append some text to the ctext widget, and make any SHA1 ID
2544 # that we know about be a clickable link.
2545 proc appendwithlinks {text} {
2546 global ctext commitrow linknum
2548 set start [$ctext index "end - 1c"]
2549 $ctext insert end $text
2550 $ctext insert end "\n"
2551 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
2555 set linkid [string range $text $s $e]
2556 if {![info exists commitrow($linkid)]} continue
2558 $ctext tag add link "$start + $s c" "$start + $e c"
2559 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
2560 $ctext tag bind link$linknum <1> [list selectline $commitrow($linkid) 1]
2563 $ctext tag conf link -foreground blue -underline 1
2564 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
2565 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
2568 proc viewnextline {dir} {
2572 set ymax [lindex [$canv cget -scrollregion] 3]
2573 set wnow [$canv yview]
2574 set wtop [expr {[lindex $wnow 0] * $ymax}]
2575 set newtop [expr {$wtop + $dir * $linespc}]
2578 } elseif {$newtop > $ymax} {
2581 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2584 proc selectline {l isnew} {
2585 global canv canv2 canv3 ctext commitinfo selectedline
2586 global displayorder linehtag linentag linedtag
2587 global canvy0 linespc parentlist childlist
2588 global cflist currentid sha1entry
2589 global commentend idtags linknum
2590 global mergemax numcommits pending_select
2592 catch {unset pending_select}
2595 if {$l < 0 || $l >= $numcommits} return
2596 set y [expr {$canvy0 + $l * $linespc}]
2597 set ymax [lindex [$canv cget -scrollregion] 3]
2598 set ytop [expr {$y - $linespc - 1}]
2599 set ybot [expr {$y + $linespc + 1}]
2600 set wnow [$canv yview]
2601 set wtop [expr {[lindex $wnow 0] * $ymax}]
2602 set wbot [expr {[lindex $wnow 1] * $ymax}]
2603 set wh [expr {$wbot - $wtop}]
2605 if {$ytop < $wtop} {
2606 if {$ybot < $wtop} {
2607 set newtop [expr {$y - $wh / 2.0}]
2610 if {$newtop > $wtop - $linespc} {
2611 set newtop [expr {$wtop - $linespc}]
2614 } elseif {$ybot > $wbot} {
2615 if {$ytop > $wbot} {
2616 set newtop [expr {$y - $wh / 2.0}]
2618 set newtop [expr {$ybot - $wh}]
2619 if {$newtop < $wtop + $linespc} {
2620 set newtop [expr {$wtop + $linespc}]
2624 if {$newtop != $wtop} {
2628 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
2632 if {![info exists linehtag($l)]} return
2634 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
2635 -tags secsel -fill [$canv cget -selectbackground]]
2637 $canv2 delete secsel
2638 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
2639 -tags secsel -fill [$canv2 cget -selectbackground]]
2641 $canv3 delete secsel
2642 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
2643 -tags secsel -fill [$canv3 cget -selectbackground]]
2647 addtohistory [list selectline $l 0]
2652 set id [lindex $displayorder $l]
2654 $sha1entry delete 0 end
2655 $sha1entry insert 0 $id
2656 $sha1entry selection from 0
2657 $sha1entry selection to end
2659 $ctext conf -state normal
2660 $ctext delete 0.0 end
2662 $ctext mark set fmark.0 0.0
2663 $ctext mark gravity fmark.0 left
2664 set info $commitinfo($id)
2665 set date [formatdate [lindex $info 2]]
2666 $ctext insert end "Author: [lindex $info 1] $date\n"
2667 set date [formatdate [lindex $info 4]]
2668 $ctext insert end "Committer: [lindex $info 3] $date\n"
2669 if {[info exists idtags($id)]} {
2670 $ctext insert end "Tags:"
2671 foreach tag $idtags($id) {
2672 $ctext insert end " $tag"
2674 $ctext insert end "\n"
2678 set olds [lindex $parentlist $l]
2679 if {[llength $olds] > 1} {
2682 if {$np >= $mergemax} {
2687 $ctext insert end "Parent: " $tag
2688 appendwithlinks [commit_descriptor $p]
2693 append comment "Parent: [commit_descriptor $p]\n"
2697 foreach c [lindex $childlist $l] {
2698 append comment "Child: [commit_descriptor $c]\n"
2701 append comment [lindex $info 5]
2703 # make anything that looks like a SHA1 ID be a clickable link
2704 appendwithlinks $comment
2706 $ctext tag delete Comments
2707 $ctext tag remove found 1.0 end
2708 $ctext conf -state disabled
2709 set commentend [$ctext index "end - 1c"]
2711 $cflist delete 0 end
2712 $cflist insert end "Comments"
2713 if {[llength $olds] <= 1} {
2720 proc selfirstline {} {
2725 proc sellastline {} {
2728 set l [expr {$numcommits - 1}]
2732 proc selnextline {dir} {
2734 if {![info exists selectedline]} return
2735 set l [expr {$selectedline + $dir}]
2740 proc selnextpage {dir} {
2741 global canv linespc selectedline numcommits
2743 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
2747 allcanvs yview scroll [expr {$dir * $lpp}] units
2748 if {![info exists selectedline]} return
2749 set l [expr {$selectedline + $dir * $lpp}]
2752 } elseif {$l >= $numcommits} {
2753 set l [expr $numcommits - 1]
2759 proc unselectline {} {
2760 global selectedline currentid
2762 catch {unset selectedline}
2763 catch {unset currentid}
2764 allcanvs delete secsel
2767 proc addtohistory {cmd} {
2768 global history historyindex
2770 if {$historyindex > 0
2771 && [lindex $history [expr {$historyindex - 1}]] == $cmd} {
2775 if {$historyindex < [llength $history]} {
2776 set history [lreplace $history $historyindex end $cmd]
2778 lappend history $cmd
2781 if {$historyindex > 1} {
2782 .ctop.top.bar.leftbut conf -state normal
2784 .ctop.top.bar.leftbut conf -state disabled
2786 .ctop.top.bar.rightbut conf -state disabled
2790 global history historyindex
2792 if {$historyindex > 1} {
2793 incr historyindex -1
2794 set cmd [lindex $history [expr {$historyindex - 1}]]
2796 .ctop.top.bar.rightbut conf -state normal
2798 if {$historyindex <= 1} {
2799 .ctop.top.bar.leftbut conf -state disabled
2804 global history historyindex
2806 if {$historyindex < [llength $history]} {
2807 set cmd [lindex $history $historyindex]
2810 .ctop.top.bar.leftbut conf -state normal
2812 if {$historyindex >= [llength $history]} {
2813 .ctop.top.bar.rightbut conf -state disabled
2817 proc mergediff {id l} {
2818 global diffmergeid diffopts mdifffd
2819 global difffilestart diffids
2824 catch {unset difffilestart}
2825 # this doesn't seem to actually affect anything...
2826 set env(GIT_DIFF_OPTS) $diffopts
2827 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
2828 if {[catch {set mdf [open $cmd r]} err]} {
2829 error_popup "Error getting merge diffs: $err"
2832 fconfigure $mdf -blocking 0
2833 set mdifffd($id) $mdf
2834 set np [llength [lindex $parentlist $l]]
2835 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2836 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2839 proc getmergediffline {mdf id np} {
2840 global diffmergeid ctext cflist nextupdate mergemax
2841 global difffilestart mdifffd
2843 set n [gets $mdf line]
2850 if {![info exists diffmergeid] || $id != $diffmergeid
2851 || $mdf != $mdifffd($id)} {
2854 $ctext conf -state normal
2855 if {[regexp {^diff --cc (.*)} $line match fname]} {
2856 # start of a new file
2857 $ctext insert end "\n"
2858 set here [$ctext index "end - 1c"]
2859 set i [$cflist index end]
2860 $ctext mark set fmark.$i $here
2861 $ctext mark gravity fmark.$i left
2862 set difffilestart([expr {$i-1}]) $here
2863 $cflist insert end $fname
2864 set l [expr {(78 - [string length $fname]) / 2}]
2865 set pad [string range "----------------------------------------" 1 $l]
2866 $ctext insert end "$pad $fname $pad\n" filesep
2867 } elseif {[regexp {^@@} $line]} {
2868 $ctext insert end "$line\n" hunksep
2869 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
2872 # parse the prefix - one ' ', '-' or '+' for each parent
2877 for {set j 0} {$j < $np} {incr j} {
2878 set c [string range $line $j $j]
2881 } elseif {$c == "-"} {
2883 } elseif {$c == "+"} {
2892 if {!$isbad && $minuses ne {} && $pluses eq {}} {
2893 # line doesn't appear in result, parents in $minuses have the line
2894 set num [lindex $minuses 0]
2895 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
2896 # line appears in result, parents in $pluses don't have the line
2897 lappend tags mresult
2898 set num [lindex $spaces 0]
2901 if {$num >= $mergemax} {
2906 $ctext insert end "$line\n" $tags
2908 $ctext conf -state disabled
2909 if {[clock clicks -milliseconds] >= $nextupdate} {
2911 fileevent $mdf readable {}
2913 fileevent $mdf readable [list getmergediffline $mdf $id $np]
2917 proc startdiff {ids} {
2918 global treediffs diffids treepending diffmergeid
2921 catch {unset diffmergeid}
2922 if {![info exists treediffs($ids)]} {
2923 if {![info exists treepending]} {
2931 proc addtocflist {ids} {
2932 global treediffs cflist
2933 foreach f $treediffs($ids) {
2934 $cflist insert end $f
2939 proc gettreediffs {ids} {
2940 global treediff treepending
2941 set treepending $ids
2944 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
2946 fconfigure $gdtf -blocking 0
2947 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2950 proc gettreediffline {gdtf ids} {
2951 global treediff treediffs treepending diffids diffmergeid
2953 set n [gets $gdtf line]
2955 if {![eof $gdtf]} return
2957 set treediffs($ids) $treediff
2959 if {$ids != $diffids} {
2960 if {![info exists diffmergeid]} {
2961 gettreediffs $diffids
2968 set file [lindex $line 5]
2969 lappend treediff $file
2972 proc getblobdiffs {ids} {
2973 global diffopts blobdifffd diffids env curdifftag curtagstart
2974 global difffilestart nextupdate diffinhdr treediffs
2976 set env(GIT_DIFF_OPTS) $diffopts
2977 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
2978 if {[catch {set bdf [open $cmd r]} err]} {
2979 puts "error getting diffs: $err"
2983 fconfigure $bdf -blocking 0
2984 set blobdifffd($ids) $bdf
2985 set curdifftag Comments
2987 catch {unset difffilestart}
2988 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
2989 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
2992 proc getblobdiffline {bdf ids} {
2993 global diffids blobdifffd ctext curdifftag curtagstart
2994 global diffnexthead diffnextnote difffilestart
2995 global nextupdate diffinhdr treediffs
2997 set n [gets $bdf line]
3001 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3002 $ctext tag add $curdifftag $curtagstart end
3007 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3010 $ctext conf -state normal
3011 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3012 # start of a new file
3013 $ctext insert end "\n"
3014 $ctext tag add $curdifftag $curtagstart end
3015 set curtagstart [$ctext index "end - 1c"]
3017 set here [$ctext index "end - 1c"]
3018 set i [lsearch -exact $treediffs($diffids) $fname]
3020 set difffilestart($i) $here
3022 $ctext mark set fmark.$i $here
3023 $ctext mark gravity fmark.$i left
3025 if {$newname != $fname} {
3026 set i [lsearch -exact $treediffs($diffids) $newname]
3028 set difffilestart($i) $here
3030 $ctext mark set fmark.$i $here
3031 $ctext mark gravity fmark.$i left
3034 set curdifftag "f:$fname"
3035 $ctext tag delete $curdifftag
3036 set l [expr {(78 - [string length $header]) / 2}]
3037 set pad [string range "----------------------------------------" 1 $l]
3038 $ctext insert end "$pad $header $pad\n" filesep
3040 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3042 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3044 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3045 $line match f1l f1c f2l f2c rest]} {
3046 $ctext insert end "$line\n" hunksep
3049 set x [string range $line 0 0]
3050 if {$x == "-" || $x == "+"} {
3051 set tag [expr {$x == "+"}]
3052 $ctext insert end "$line\n" d$tag
3053 } elseif {$x == " "} {
3054 $ctext insert end "$line\n"
3055 } elseif {$diffinhdr || $x == "\\"} {
3056 # e.g. "\ No newline at end of file"
3057 $ctext insert end "$line\n" filesep
3059 # Something else we don't recognize
3060 if {$curdifftag != "Comments"} {
3061 $ctext insert end "\n"
3062 $ctext tag add $curdifftag $curtagstart end
3063 set curtagstart [$ctext index "end - 1c"]
3064 set curdifftag Comments
3066 $ctext insert end "$line\n" filesep
3069 $ctext conf -state disabled
3070 if {[clock clicks -milliseconds] >= $nextupdate} {
3072 fileevent $bdf readable {}
3074 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3079 global difffilestart ctext
3080 set here [$ctext index @0,0]
3081 for {set i 0} {[info exists difffilestart($i)]} {incr i} {
3082 if {[$ctext compare $difffilestart($i) > $here]} {
3083 if {![info exists pos]
3084 || [$ctext compare $difffilestart($i) < $pos]} {
3085 set pos $difffilestart($i)
3089 if {[info exists pos]} {
3094 proc listboxsel {} {
3095 global ctext cflist currentid
3096 if {![info exists currentid]} return
3097 set sel [lsort [$cflist curselection]]
3098 if {$sel eq {}} return
3099 set first [lindex $sel 0]
3100 catch {$ctext yview fmark.$first}
3104 global linespc charspc canvx0 canvy0 mainfont
3105 global xspc1 xspc2 lthickness
3107 set linespc [font metrics $mainfont -linespace]
3108 set charspc [font measure $mainfont "m"]
3109 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
3110 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
3111 set lthickness [expr {int($linespc / 9) + 1}]
3112 set xspc1(0) $linespc
3120 set ymax [lindex [$canv cget -scrollregion] 3]
3121 if {$ymax eq {} || $ymax == 0} return
3122 set span [$canv yview]
3125 allcanvs yview moveto [lindex $span 0]
3127 if {[info exists selectedline]} {
3128 selectline $selectedline 0
3132 proc incrfont {inc} {
3133 global mainfont namefont textfont ctext canv phase
3134 global stopped entries
3136 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
3137 set namefont [lreplace $namefont 1 1 [expr {[lindex $namefont 1] + $inc}]]
3138 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
3140 $ctext conf -font $textfont
3141 $ctext tag conf filesep -font [concat $textfont bold]
3142 foreach e $entries {
3143 $e conf -font $mainfont
3145 if {$phase == "getcommits"} {
3146 $canv itemconf textitems -font $mainfont
3152 global sha1entry sha1string
3153 if {[string length $sha1string] == 40} {
3154 $sha1entry delete 0 end
3158 proc sha1change {n1 n2 op} {
3159 global sha1string currentid sha1but
3160 if {$sha1string == {}
3161 || ([info exists currentid] && $sha1string == $currentid)} {
3166 if {[$sha1but cget -state] == $state} return
3167 if {$state == "normal"} {
3168 $sha1but conf -state normal -relief raised -text "Goto: "
3170 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
3174 proc gotocommit {} {
3175 global sha1string currentid commitrow tagids headids
3176 global displayorder numcommits
3178 if {$sha1string == {}
3179 || ([info exists currentid] && $sha1string == $currentid)} return
3180 if {[info exists tagids($sha1string)]} {
3181 set id $tagids($sha1string)
3182 } elseif {[info exists headids($sha1string)]} {
3183 set id $headids($sha1string)
3185 set id [string tolower $sha1string]
3186 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
3188 foreach i $displayorder {
3189 if {[string match $id* $i]} {
3193 if {$matches ne {}} {
3194 if {[llength $matches] > 1} {
3195 error_popup "Short SHA1 id $id is ambiguous"
3198 set id [lindex $matches 0]
3202 if {[info exists commitrow($id)]} {
3203 selectline $commitrow($id) 1
3206 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
3211 error_popup "$type $sha1string is not known"
3214 proc lineenter {x y id} {
3215 global hoverx hovery hoverid hovertimer
3216 global commitinfo canv
3218 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3222 if {[info exists hovertimer]} {
3223 after cancel $hovertimer
3225 set hovertimer [after 500 linehover]
3229 proc linemotion {x y id} {
3230 global hoverx hovery hoverid hovertimer
3232 if {[info exists hoverid] && $id == $hoverid} {
3235 if {[info exists hovertimer]} {
3236 after cancel $hovertimer
3238 set hovertimer [after 500 linehover]
3242 proc lineleave {id} {
3243 global hoverid hovertimer canv
3245 if {[info exists hoverid] && $id == $hoverid} {
3247 if {[info exists hovertimer]} {
3248 after cancel $hovertimer
3256 global hoverx hovery hoverid hovertimer
3257 global canv linespc lthickness
3258 global commitinfo mainfont
3260 set text [lindex $commitinfo($hoverid) 0]
3261 set ymax [lindex [$canv cget -scrollregion] 3]
3262 if {$ymax == {}} return
3263 set yfrac [lindex [$canv yview] 0]
3264 set x [expr {$hoverx + 2 * $linespc}]
3265 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
3266 set x0 [expr {$x - 2 * $lthickness}]
3267 set y0 [expr {$y - 2 * $lthickness}]
3268 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
3269 set y1 [expr {$y + $linespc + 2 * $lthickness}]
3270 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
3271 -fill \#ffff80 -outline black -width 1 -tags hover]
3273 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
3277 proc clickisonarrow {id y} {
3280 set ranges [rowranges $id]
3281 set thresh [expr {2 * $lthickness + 6}]
3282 set n [expr {[llength $ranges] - 1}]
3283 for {set i 1} {$i < $n} {incr i} {
3284 set row [lindex $ranges $i]
3285 if {abs([yc $row] - $y) < $thresh} {
3292 proc arrowjump {id n y} {
3295 # 1 <-> 2, 3 <-> 4, etc...
3296 set n [expr {(($n - 1) ^ 1) + 1}]
3297 set row [lindex [rowranges $id] $n]
3299 set ymax [lindex [$canv cget -scrollregion] 3]
3300 if {$ymax eq {} || $ymax <= 0} return
3301 set view [$canv yview]
3302 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
3303 set yfrac [expr {$yt / $ymax - $yspan / 2}]
3307 allcanvs yview moveto $yfrac
3310 proc lineclick {x y id isnew} {
3311 global ctext commitinfo childlist commitrow cflist canv thickerline
3313 if {![info exists commitinfo($id)] && ![getcommit $id]} return
3318 # draw this line thicker than normal
3322 set ymax [lindex [$canv cget -scrollregion] 3]
3323 if {$ymax eq {}} return
3324 set yfrac [lindex [$canv yview] 0]
3325 set y [expr {$y + $yfrac * $ymax}]
3327 set dirn [clickisonarrow $id $y]
3329 arrowjump $id $dirn $y
3334 addtohistory [list lineclick $x $y $id 0]
3336 # fill the details pane with info about this line
3337 $ctext conf -state normal
3338 $ctext delete 0.0 end
3339 $ctext tag conf link -foreground blue -underline 1
3340 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3341 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3342 $ctext insert end "Parent:\t"
3343 $ctext insert end $id [list link link0]
3344 $ctext tag bind link0 <1> [list selbyid $id]
3345 set info $commitinfo($id)
3346 $ctext insert end "\n\t[lindex $info 0]\n"
3347 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
3348 set date [formatdate [lindex $info 2]]
3349 $ctext insert end "\tDate:\t$date\n"
3350 set kids [lindex $childlist $commitrow($id)]
3352 $ctext insert end "\nChildren:"
3354 foreach child $kids {
3356 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
3357 set info $commitinfo($child)
3358 $ctext insert end "\n\t"
3359 $ctext insert end $child [list link link$i]
3360 $ctext tag bind link$i <1> [list selbyid $child]
3361 $ctext insert end "\n\t[lindex $info 0]"
3362 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
3363 set date [formatdate [lindex $info 2]]
3364 $ctext insert end "\n\tDate:\t$date\n"
3367 $ctext conf -state disabled
3369 $cflist delete 0 end
3372 proc normalline {} {
3374 if {[info exists thickerline]} {
3383 if {[info exists commitrow($id)]} {
3384 selectline $commitrow($id) 1
3390 if {![info exists startmstime]} {
3391 set startmstime [clock clicks -milliseconds]
3393 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
3396 proc rowmenu {x y id} {
3397 global rowctxmenu commitrow selectedline rowmenuid
3399 if {![info exists selectedline] || $commitrow($id) eq $selectedline} {
3404 $rowctxmenu entryconfigure 0 -state $state
3405 $rowctxmenu entryconfigure 1 -state $state
3406 $rowctxmenu entryconfigure 2 -state $state
3408 tk_popup $rowctxmenu $x $y
3411 proc diffvssel {dirn} {
3412 global rowmenuid selectedline displayorder
3414 if {![info exists selectedline]} return
3416 set oldid [lindex $displayorder $selectedline]
3417 set newid $rowmenuid
3419 set oldid $rowmenuid
3420 set newid [lindex $displayorder $selectedline]
3422 addtohistory [list doseldiff $oldid $newid]
3423 doseldiff $oldid $newid
3426 proc doseldiff {oldid newid} {
3430 $ctext conf -state normal
3431 $ctext delete 0.0 end
3432 $ctext mark set fmark.0 0.0
3433 $ctext mark gravity fmark.0 left
3434 $cflist delete 0 end
3435 $cflist insert end "Top"
3436 $ctext insert end "From "
3437 $ctext tag conf link -foreground blue -underline 1
3438 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3439 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3440 $ctext tag bind link0 <1> [list selbyid $oldid]
3441 $ctext insert end $oldid [list link link0]
3442 $ctext insert end "\n "
3443 $ctext insert end [lindex $commitinfo($oldid) 0]
3444 $ctext insert end "\n\nTo "
3445 $ctext tag bind link1 <1> [list selbyid $newid]
3446 $ctext insert end $newid [list link link1]
3447 $ctext insert end "\n "
3448 $ctext insert end [lindex $commitinfo($newid) 0]
3449 $ctext insert end "\n"
3450 $ctext conf -state disabled
3451 $ctext tag delete Comments
3452 $ctext tag remove found 1.0 end
3453 startdiff [list $oldid $newid]
3457 global rowmenuid currentid commitinfo patchtop patchnum
3459 if {![info exists currentid]} return
3460 set oldid $currentid
3461 set oldhead [lindex $commitinfo($oldid) 0]
3462 set newid $rowmenuid
3463 set newhead [lindex $commitinfo($newid) 0]
3466 catch {destroy $top}
3468 label $top.title -text "Generate patch"
3469 grid $top.title - -pady 10
3470 label $top.from -text "From:"
3471 entry $top.fromsha1 -width 40 -relief flat
3472 $top.fromsha1 insert 0 $oldid
3473 $top.fromsha1 conf -state readonly
3474 grid $top.from $top.fromsha1 -sticky w
3475 entry $top.fromhead -width 60 -relief flat
3476 $top.fromhead insert 0 $oldhead
3477 $top.fromhead conf -state readonly
3478 grid x $top.fromhead -sticky w
3479 label $top.to -text "To:"
3480 entry $top.tosha1 -width 40 -relief flat
3481 $top.tosha1 insert 0 $newid
3482 $top.tosha1 conf -state readonly
3483 grid $top.to $top.tosha1 -sticky w
3484 entry $top.tohead -width 60 -relief flat
3485 $top.tohead insert 0 $newhead
3486 $top.tohead conf -state readonly
3487 grid x $top.tohead -sticky w
3488 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
3489 grid $top.rev x -pady 10
3490 label $top.flab -text "Output file:"
3491 entry $top.fname -width 60
3492 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
3494 grid $top.flab $top.fname -sticky w
3496 button $top.buts.gen -text "Generate" -command mkpatchgo
3497 button $top.buts.can -text "Cancel" -command mkpatchcan
3498 grid $top.buts.gen $top.buts.can
3499 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3500 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3501 grid $top.buts - -pady 10 -sticky ew
3505 proc mkpatchrev {} {
3508 set oldid [$patchtop.fromsha1 get]
3509 set oldhead [$patchtop.fromhead get]
3510 set newid [$patchtop.tosha1 get]
3511 set newhead [$patchtop.tohead get]
3512 foreach e [list fromsha1 fromhead tosha1 tohead] \
3513 v [list $newid $newhead $oldid $oldhead] {
3514 $patchtop.$e conf -state normal
3515 $patchtop.$e delete 0 end
3516 $patchtop.$e insert 0 $v
3517 $patchtop.$e conf -state readonly
3524 set oldid [$patchtop.fromsha1 get]
3525 set newid [$patchtop.tosha1 get]
3526 set fname [$patchtop.fname get]
3527 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
3528 error_popup "Error creating patch: $err"
3530 catch {destroy $patchtop}
3534 proc mkpatchcan {} {
3537 catch {destroy $patchtop}
3542 global rowmenuid mktagtop commitinfo
3546 catch {destroy $top}
3548 label $top.title -text "Create tag"
3549 grid $top.title - -pady 10
3550 label $top.id -text "ID:"
3551 entry $top.sha1 -width 40 -relief flat
3552 $top.sha1 insert 0 $rowmenuid
3553 $top.sha1 conf -state readonly
3554 grid $top.id $top.sha1 -sticky w
3555 entry $top.head -width 60 -relief flat
3556 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3557 $top.head conf -state readonly
3558 grid x $top.head -sticky w
3559 label $top.tlab -text "Tag name:"
3560 entry $top.tag -width 60
3561 grid $top.tlab $top.tag -sticky w
3563 button $top.buts.gen -text "Create" -command mktaggo
3564 button $top.buts.can -text "Cancel" -command mktagcan
3565 grid $top.buts.gen $top.buts.can
3566 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3567 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3568 grid $top.buts - -pady 10 -sticky ew
3573 global mktagtop env tagids idtags
3575 set id [$mktagtop.sha1 get]
3576 set tag [$mktagtop.tag get]
3578 error_popup "No tag name specified"
3581 if {[info exists tagids($tag)]} {
3582 error_popup "Tag \"$tag\" already exists"
3587 set fname [file join $dir "refs/tags" $tag]
3588 set f [open $fname w]
3592 error_popup "Error creating tag: $err"
3596 set tagids($tag) $id
3597 lappend idtags($id) $tag
3601 proc redrawtags {id} {
3602 global canv linehtag commitrow idpos selectedline
3604 if {![info exists commitrow($id)]} return
3605 drawcmitrow $commitrow($id)
3606 $canv delete tag.$id
3607 set xt [eval drawtags $id $idpos($id)]
3608 $canv coords $linehtag($commitrow($id)) $xt [lindex $idpos($id) 2]
3609 if {[info exists selectedline] && $selectedline == $commitrow($id)} {
3610 selectline $selectedline 0
3617 catch {destroy $mktagtop}
3626 proc writecommit {} {
3627 global rowmenuid wrcomtop commitinfo wrcomcmd
3629 set top .writecommit
3631 catch {destroy $top}
3633 label $top.title -text "Write commit to file"
3634 grid $top.title - -pady 10
3635 label $top.id -text "ID:"
3636 entry $top.sha1 -width 40 -relief flat
3637 $top.sha1 insert 0 $rowmenuid
3638 $top.sha1 conf -state readonly
3639 grid $top.id $top.sha1 -sticky w
3640 entry $top.head -width 60 -relief flat
3641 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
3642 $top.head conf -state readonly
3643 grid x $top.head -sticky w
3644 label $top.clab -text "Command:"
3645 entry $top.cmd -width 60 -textvariable wrcomcmd
3646 grid $top.clab $top.cmd -sticky w -pady 10
3647 label $top.flab -text "Output file:"
3648 entry $top.fname -width 60
3649 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
3650 grid $top.flab $top.fname -sticky w
3652 button $top.buts.gen -text "Write" -command wrcomgo
3653 button $top.buts.can -text "Cancel" -command wrcomcan
3654 grid $top.buts.gen $top.buts.can
3655 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3656 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3657 grid $top.buts - -pady 10 -sticky ew
3664 set id [$wrcomtop.sha1 get]
3665 set cmd "echo $id | [$wrcomtop.cmd get]"
3666 set fname [$wrcomtop.fname get]
3667 if {[catch {exec sh -c $cmd >$fname &} err]} {
3668 error_popup "Error writing commit: $err"
3670 catch {destroy $wrcomtop}
3677 catch {destroy $wrcomtop}
3681 proc listrefs {id} {
3682 global idtags idheads idotherrefs
3685 if {[info exists idtags($id)]} {
3689 if {[info exists idheads($id)]} {
3693 if {[info exists idotherrefs($id)]} {
3694 set z $idotherrefs($id)
3696 return [list $x $y $z]
3699 proc rereadrefs {} {
3700 global idtags idheads idotherrefs
3702 set refids [concat [array names idtags] \
3703 [array names idheads] [array names idotherrefs]]
3704 foreach id $refids {
3705 if {![info exists ref($id)]} {
3706 set ref($id) [listrefs $id]
3710 set refids [lsort -unique [concat $refids [array names idtags] \
3711 [array names idheads] [array names idotherrefs]]]
3712 foreach id $refids {
3713 set v [listrefs $id]
3714 if {![info exists ref($id)] || $ref($id) != $v} {
3720 proc showtag {tag isnew} {
3721 global ctext cflist tagcontents tagids linknum
3724 addtohistory [list showtag $tag 0]
3726 $ctext conf -state normal
3727 $ctext delete 0.0 end
3729 if {[info exists tagcontents($tag)]} {
3730 set text $tagcontents($tag)
3732 set text "Tag: $tag\nId: $tagids($tag)"
3734 appendwithlinks $text
3735 $ctext conf -state disabled
3736 $cflist delete 0 end
3746 global maxwidth maxgraphpct diffopts findmergefiles
3747 global oldprefs prefstop
3751 if {[winfo exists $top]} {
3755 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3756 set oldprefs($v) [set $v]
3759 wm title $top "Gitk preferences"
3760 label $top.ldisp -text "Commit list display options"
3761 grid $top.ldisp - -sticky w -pady 10
3762 label $top.spacer -text " "
3763 label $top.maxwidthl -text "Maximum graph width (lines)" \
3765 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
3766 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
3767 label $top.maxpctl -text "Maximum graph width (% of pane)" \
3769 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
3770 grid x $top.maxpctl $top.maxpct -sticky w
3771 checkbutton $top.findm -variable findmergefiles
3772 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
3774 grid $top.findm $top.findml - -sticky w
3775 label $top.ddisp -text "Diff display options"
3776 grid $top.ddisp - -sticky w -pady 10
3777 label $top.diffoptl -text "Options for diff program" \
3779 entry $top.diffopt -width 20 -textvariable diffopts
3780 grid x $top.diffoptl $top.diffopt -sticky w
3782 button $top.buts.ok -text "OK" -command prefsok
3783 button $top.buts.can -text "Cancel" -command prefscan
3784 grid $top.buts.ok $top.buts.can
3785 grid columnconfigure $top.buts 0 -weight 1 -uniform a
3786 grid columnconfigure $top.buts 1 -weight 1 -uniform a
3787 grid $top.buts - - -pady 10 -sticky ew
3791 global maxwidth maxgraphpct diffopts findmergefiles
3792 global oldprefs prefstop
3794 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
3795 set $v $oldprefs($v)
3797 catch {destroy $prefstop}
3802 global maxwidth maxgraphpct
3803 global oldprefs prefstop
3805 catch {destroy $prefstop}
3807 if {$maxwidth != $oldprefs(maxwidth)
3808 || $maxgraphpct != $oldprefs(maxgraphpct)} {
3813 proc formatdate {d} {
3814 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
3817 # This list of encoding names and aliases is distilled from
3818 # http://www.iana.org/assignments/character-sets.
3819 # Not all of them are supported by Tcl.
3820 set encoding_aliases {
3821 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
3822 ISO646-US US-ASCII us IBM367 cp367 csASCII }
3823 { ISO-10646-UTF-1 csISO10646UTF1 }
3824 { ISO_646.basic:1983 ref csISO646basic1983 }
3825 { INVARIANT csINVARIANT }
3826 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
3827 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
3828 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
3829 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
3830 { NATS-DANO iso-ir-9-1 csNATSDANO }
3831 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
3832 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
3833 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
3834 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
3835 { ISO-2022-KR csISO2022KR }
3837 { ISO-2022-JP csISO2022JP }
3838 { ISO-2022-JP-2 csISO2022JP2 }
3839 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
3841 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
3842 { IT iso-ir-15 ISO646-IT csISO15Italian }
3843 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
3844 { ES iso-ir-17 ISO646-ES csISO17Spanish }
3845 { greek7-old iso-ir-18 csISO18Greek7Old }
3846 { latin-greek iso-ir-19 csISO19LatinGreek }
3847 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
3848 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
3849 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
3850 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
3851 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
3852 { BS_viewdata iso-ir-47 csISO47BSViewdata }
3853 { INIS iso-ir-49 csISO49INIS }
3854 { INIS-8 iso-ir-50 csISO50INIS8 }
3855 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
3856 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
3857 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
3858 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
3859 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
3860 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
3862 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
3863 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
3864 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
3865 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
3866 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
3867 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
3868 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
3869 { greek7 iso-ir-88 csISO88Greek7 }
3870 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
3871 { iso-ir-90 csISO90 }
3872 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
3873 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
3874 csISO92JISC62991984b }
3875 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
3876 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
3877 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
3878 csISO95JIS62291984handadd }
3879 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
3880 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
3881 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
3882 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
3884 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
3885 { T.61-7bit iso-ir-102 csISO102T617bit }
3886 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
3887 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
3888 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
3889 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
3890 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
3891 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
3892 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
3893 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
3894 arabic csISOLatinArabic }
3895 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
3896 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
3897 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
3898 greek greek8 csISOLatinGreek }
3899 { T.101-G2 iso-ir-128 csISO128T101G2 }
3900 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
3902 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
3903 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
3904 { CSN_369103 iso-ir-139 csISO139CSN369103 }
3905 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
3906 { ISO_6937-2-add iso-ir-142 csISOTextComm }
3907 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
3908 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
3909 csISOLatinCyrillic }
3910 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
3911 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
3912 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
3913 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
3914 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
3915 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
3916 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
3917 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
3918 { ISO_10367-box iso-ir-155 csISO10367Box }
3919 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
3920 { latin-lap lap iso-ir-158 csISO158Lap }
3921 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
3922 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
3925 { JIS_X0201 X0201 csHalfWidthKatakana }
3926 { KSC5636 ISO646-KR csKSC5636 }
3927 { ISO-10646-UCS-2 csUnicode }
3928 { ISO-10646-UCS-4 csUCS4 }
3929 { DEC-MCS dec csDECMCS }
3930 { hp-roman8 roman8 r8 csHPRoman8 }
3931 { macintosh mac csMacintosh }
3932 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
3934 { IBM038 EBCDIC-INT cp038 csIBM038 }
3935 { IBM273 CP273 csIBM273 }
3936 { IBM274 EBCDIC-BE CP274 csIBM274 }
3937 { IBM275 EBCDIC-BR cp275 csIBM275 }
3938 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
3939 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
3940 { IBM280 CP280 ebcdic-cp-it csIBM280 }
3941 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
3942 { IBM284 CP284 ebcdic-cp-es csIBM284 }
3943 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
3944 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
3945 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
3946 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
3947 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
3948 { IBM424 cp424 ebcdic-cp-he csIBM424 }
3949 { IBM437 cp437 437 csPC8CodePage437 }
3950 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
3951 { IBM775 cp775 csPC775Baltic }
3952 { IBM850 cp850 850 csPC850Multilingual }
3953 { IBM851 cp851 851 csIBM851 }
3954 { IBM852 cp852 852 csPCp852 }
3955 { IBM855 cp855 855 csIBM855 }
3956 { IBM857 cp857 857 csIBM857 }
3957 { IBM860 cp860 860 csIBM860 }
3958 { IBM861 cp861 861 cp-is csIBM861 }
3959 { IBM862 cp862 862 csPC862LatinHebrew }
3960 { IBM863 cp863 863 csIBM863 }
3961 { IBM864 cp864 csIBM864 }
3962 { IBM865 cp865 865 csIBM865 }
3963 { IBM866 cp866 866 csIBM866 }
3964 { IBM868 CP868 cp-ar csIBM868 }
3965 { IBM869 cp869 869 cp-gr csIBM869 }
3966 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
3967 { IBM871 CP871 ebcdic-cp-is csIBM871 }
3968 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
3969 { IBM891 cp891 csIBM891 }
3970 { IBM903 cp903 csIBM903 }
3971 { IBM904 cp904 904 csIBBM904 }
3972 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
3973 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
3974 { IBM1026 CP1026 csIBM1026 }
3975 { EBCDIC-AT-DE csIBMEBCDICATDE }
3976 { EBCDIC-AT-DE-A csEBCDICATDEA }
3977 { EBCDIC-CA-FR csEBCDICCAFR }
3978 { EBCDIC-DK-NO csEBCDICDKNO }
3979 { EBCDIC-DK-NO-A csEBCDICDKNOA }
3980 { EBCDIC-FI-SE csEBCDICFISE }
3981 { EBCDIC-FI-SE-A csEBCDICFISEA }
3982 { EBCDIC-FR csEBCDICFR }
3983 { EBCDIC-IT csEBCDICIT }
3984 { EBCDIC-PT csEBCDICPT }
3985 { EBCDIC-ES csEBCDICES }
3986 { EBCDIC-ES-A csEBCDICESA }
3987 { EBCDIC-ES-S csEBCDICESS }
3988 { EBCDIC-UK csEBCDICUK }
3989 { EBCDIC-US csEBCDICUS }
3990 { UNKNOWN-8BIT csUnknown8BiT }
3991 { MNEMONIC csMnemonic }
3996 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
3997 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
3998 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
3999 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4000 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4001 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4002 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4003 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4004 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4005 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4006 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4007 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4008 { IBM1047 IBM-1047 }
4009 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4010 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4011 { UNICODE-1-1 csUnicode11 }
4014 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4015 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4017 { ISO-8859-15 ISO_8859-15 Latin-9 }
4018 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4019 { GBK CP936 MS936 windows-936 }
4020 { JIS_Encoding csJISEncoding }
4021 { Shift_JIS MS_Kanji csShiftJIS }
4022 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4024 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4025 { ISO-10646-UCS-Basic csUnicodeASCII }
4026 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4027 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
4028 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
4029 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
4030 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
4031 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
4032 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
4033 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
4034 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
4035 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
4036 { Adobe-Standard-Encoding csAdobeStandardEncoding }
4037 { Ventura-US csVenturaUS }
4038 { Ventura-International csVenturaInternational }
4039 { PC8-Danish-Norwegian csPC8DanishNorwegian }
4040 { PC8-Turkish csPC8Turkish }
4041 { IBM-Symbols csIBMSymbols }
4042 { IBM-Thai csIBMThai }
4043 { HP-Legal csHPLegal }
4044 { HP-Pi-font csHPPiFont }
4045 { HP-Math8 csHPMath8 }
4046 { Adobe-Symbol-Encoding csHPPSMath }
4047 { HP-DeskTop csHPDesktop }
4048 { Ventura-Math csVenturaMath }
4049 { Microsoft-Publishing csMicrosoftPublishing }
4050 { Windows-31J csWindows31J }
4055 proc tcl_encoding {enc} {
4056 global encoding_aliases
4057 set names [encoding names]
4058 set lcnames [string tolower $names]
4059 set enc [string tolower $enc]
4060 set i [lsearch -exact $lcnames $enc]
4062 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
4063 if {[regsub {^iso[-_]} $enc iso encx]} {
4064 set i [lsearch -exact $lcnames $encx]
4068 foreach l $encoding_aliases {
4069 set ll [string tolower $l]
4070 if {[lsearch -exact $ll $enc] < 0} continue
4071 # look through the aliases for one that tcl knows about
4073 set i [lsearch -exact $lcnames $e]
4075 if {[regsub {^iso[-_]} $e iso ex]} {
4076 set i [lsearch -exact $lcnames $ex]
4085 return [lindex $names $i]
4092 set diffopts "-U 5 -p"
4093 set wrcomcmd "git-diff-tree --stdin -p --pretty"
4097 set gitencoding [exec git-repo-config --get i18n.commitencoding]
4099 if {$gitencoding == ""} {
4100 set gitencoding "utf-8"
4102 set tclencoding [tcl_encoding $gitencoding]
4103 if {$tclencoding == {}} {
4104 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
4107 set mainfont {Helvetica 9}
4108 set textfont {Courier 9}
4109 set uifont {Helvetica 9 bold}
4110 set findmergefiles 0
4119 set colors {green red blue magenta darkgrey brown orange}
4121 catch {source ~/.gitk}
4123 set namefont $mainfont
4125 font create optionfont -family sans-serif -size -12
4129 switch -regexp -- $arg {
4131 "^-d" { set datemode 1 }
4133 lappend revtreeargs $arg
4138 # check that we can find a .git directory somewhere...
4140 if {![file isdirectory $gitdir]} {
4141 error_popup "Cannot find the git directory \"$gitdir\"."
4160 parse_args $revtreeargs
4161 set args $parsed_args
4162 if {$cmdline_files ne {}} {
4163 # create a view for the files/dirs specified on the command line
4166 set viewname(1) "Command line"
4167 set viewfiles(1) $cmdline_files
4168 .bar.view add command -label $viewname(1) -command {showview 1}
4169 .bar.view entryconf 2 -state normal
4170 set args [concat $args "--" $cmdline_files]