2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env(GIT_DIR)]} {
19 proc start_rev_list {view} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
27 set commitidx($view) 0
28 set args $viewargs($view)
29 if {$viewfiles($view) ne {}} {
30 set args [concat $args "--" $viewfiles($view)]
32 set order "--topo-order"
34 set order "--date-order"
37 set fd [open [concat | git-rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
40 puts stderr "Error executing git-rev-list: $err"
44 set leftover($view) {}
45 fconfigure $fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure $fd -encoding $tclencoding
49 fileevent $fd readable [list getcommitlines $fd $view]
53 proc stop_rev_list {} {
56 if {![info exists commfd($curview)]} return
57 set fd $commfd($curview)
63 unset commfd($curview)
67 global phase canv mainfont curview
71 start_rev_list $curview
72 show_status "Reading commits..."
75 proc getcommitlines {fd view} {
76 global commitlisted nextupdate
77 global leftover commfd
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children curview hlview
80 global vparentlist vchildlist vdisporder vcmitlisted
84 if {![eof $fd]} return
88 # set it blocking so we wait for the process to terminate
89 fconfigure $fd -blocking 1
90 if {[catch {close $fd} err]} {
92 if {$view != $curview} {
93 set fv " for the \"$viewname($view)\" view"
95 if {[string range $err 0 4] == "usage"} {
96 set err "Gitk: error reading commits$fv:\
97 bad arguments to git-rev-list."
98 if {$viewname($view) eq "Command line"} {
100 " (Note: arguments to gitk are passed to git-rev-list\
101 to allow selection of commits to be displayed.)"
104 set err "Error reading commits$fv: $err"
108 if {$view == $curview} {
109 after idle finishcommits
116 set i [string first "\0" $stuff $start]
118 append leftover($view) [string range $stuff $start end]
122 set cmit $leftover($view)
123 append cmit [string range $stuff 0 [expr {$i - 1}]]
124 set leftover($view) {}
126 set cmit [string range $stuff $start [expr {$i - 1}]]
128 set start [expr {$i + 1}]
129 set j [string first "\n" $cmit]
133 set ids [string range $cmit 0 [expr {$j - 1}]]
134 if {[string range $ids 0 0] == "-"} {
136 set ids [string range $ids 1 end]
140 if {[string length $id] != 40} {
148 if {[string length $shortcmit] > 80} {
149 set shortcmit "[string range $shortcmit 0 80]..."
151 error_popup "Can't parse git-rev-list output: {$shortcmit}"
154 set id [lindex $ids 0]
156 set olds [lrange $ids 1 end]
159 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
160 lappend children($view,$p) $id
167 if {![info exists children($view,$id)]} {
168 set children($view,$id) {}
170 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
171 set commitrow($view,$id) $commitidx($view)
172 incr commitidx($view)
173 if {$view == $curview} {
174 lappend parentlist $olds
175 lappend childlist $children($view,$id)
176 lappend displayorder $id
177 lappend commitlisted $listed
179 lappend vparentlist($view) $olds
180 lappend vchildlist($view) $children($view,$id)
181 lappend vdisporder($view) $id
182 lappend vcmitlisted($view) $listed
187 if {$view == $curview} {
189 } elseif {[info exists hlview] && $view == $hlview} {
193 if {[clock clicks -milliseconds] >= $nextupdate} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v [array names commfd] {
202 fileevent $commfd($v) readable {}
205 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
206 if {$numcommits < 100} {
207 set ncmupdate [expr {$numcommits + 1}]
208 } elseif {$numcommits < 10000} {
209 set ncmupdate [expr {$numcommits + 10}]
211 set ncmupdate [expr {$numcommits + 100}]
213 foreach v [array names commfd] {
215 fileevent $fd readable [list getcommitlines $fd $v]
219 proc readcommit {id} {
220 if {[catch {set contents [exec git-cat-file commit $id]}]} return
221 parsecommit $id $contents 0
224 proc updatecommits {} {
225 global viewdata curview phase displayorder
226 global children commitrow selectedline thickerline
233 foreach id $displayorder {
234 catch {unset children($n,$id)}
235 catch {unset commitrow($n,$id)}
238 catch {unset selectedline}
239 catch {unset thickerline}
240 catch {unset viewdata($n)}
245 proc parsecommit {id contents listed} {
246 global commitinfo cdate
255 set hdrend [string first "\n\n" $contents]
257 # should never happen...
258 set hdrend [string length $contents]
260 set header [string range $contents 0 [expr {$hdrend - 1}]]
261 set comment [string range $contents [expr {$hdrend + 2}] end]
262 foreach line [split $header "\n"] {
263 set tag [lindex $line 0]
264 if {$tag == "author"} {
265 set audate [lindex $line end-1]
266 set auname [lrange $line 1 end-2]
267 } elseif {$tag == "committer"} {
268 set comdate [lindex $line end-1]
269 set comname [lrange $line 1 end-2]
273 # take the first line of the comment as the headline
274 set i [string first "\n" $comment]
276 set headline [string trim [string range $comment 0 $i]]
278 set headline $comment
281 # git-rev-list indents the comment by 4 spaces;
282 # if we got this via git-cat-file, add the indentation
284 foreach line [split $comment "\n"] {
285 append newcomment " "
286 append newcomment $line
287 append newcomment "\n"
289 set comment $newcomment
291 if {$comdate != {}} {
292 set cdate($id) $comdate
294 set commitinfo($id) [list $headline $auname $audate \
295 $comname $comdate $comment]
298 proc getcommit {id} {
299 global commitdata commitinfo
301 if {[info exists commitdata($id)]} {
302 parsecommit $id $commitdata($id) 1
305 if {![info exists commitinfo($id)]} {
306 set commitinfo($id) {"No commit information available"}
313 global tagids idtags headids idheads tagcontents
314 global otherrefids idotherrefs
316 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
319 set refd [open [list | git ls-remote [gitdir]] r]
320 while {0 <= [set n [gets $refd line]]} {
321 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
325 if {[regexp {^remotes/.*/HEAD$} $path match]} {
328 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
332 if {[regexp {^remotes/} $path match]} {
335 if {$type == "tags"} {
336 set tagids($name) $id
337 lappend idtags($id) $name
342 set commit [exec git-rev-parse "$id^0"]
343 if {"$commit" != "$id"} {
344 set tagids($name) $commit
345 lappend idtags($commit) $name
349 set tagcontents($name) [exec git-cat-file tag "$id"]
351 } elseif { $type == "heads" } {
352 set headids($name) $id
353 lappend idheads($id) $name
355 set otherrefids($name) $id
356 lappend idotherrefs($id) $name
362 proc show_error {w msg} {
363 message $w.m -text $msg -justify center -aspect 400
364 pack $w.m -side top -fill x -padx 20 -pady 20
365 button $w.ok -text OK -command "destroy $w"
366 pack $w.ok -side bottom -fill x
367 bind $w <Visibility> "grab $w; focus $w"
368 bind $w <Key-Return> "destroy $w"
372 proc error_popup msg {
380 global canv canv2 canv3 linespc charspc ctext cflist
381 global textfont mainfont uifont
382 global findtype findtypemenu findloc findstring fstring geometry
383 global entries sha1entry sha1string sha1but
384 global maincursor textcursor curtextcursor
385 global rowctxmenu mergemax
386 global highlight_files gdttype
387 global searchstring sstring
390 .bar add cascade -label "File" -menu .bar.file
391 .bar configure -font $uifont
393 .bar.file add command -label "Update" -command updatecommits
394 .bar.file add command -label "Reread references" -command rereadrefs
395 .bar.file add command -label "Quit" -command doquit
396 .bar.file configure -font $uifont
398 .bar add cascade -label "Edit" -menu .bar.edit
399 .bar.edit add command -label "Preferences" -command doprefs
400 .bar.edit configure -font $uifont
402 menu .bar.view -font $uifont
403 .bar add cascade -label "View" -menu .bar.view
404 .bar.view add command -label "New view..." -command {newview 0}
405 .bar.view add command -label "Edit view..." -command editview \
407 .bar.view add command -label "Delete view" -command delview -state disabled
408 .bar.view add separator
409 .bar.view add radiobutton -label "All files" -command {showview 0} \
410 -variable selectedview -value 0
413 .bar add cascade -label "Help" -menu .bar.help
414 .bar.help add command -label "About gitk" -command about
415 .bar.help add command -label "Key bindings" -command keys
416 .bar.help configure -font $uifont
417 . configure -menu .bar
419 if {![info exists geometry(canv1)]} {
420 set geometry(canv1) [expr {45 * $charspc}]
421 set geometry(canv2) [expr {30 * $charspc}]
422 set geometry(canv3) [expr {15 * $charspc}]
423 set geometry(canvh) [expr {25 * $linespc + 4}]
424 set geometry(ctextw) 80
425 set geometry(ctexth) 30
426 set geometry(cflistw) 30
428 panedwindow .ctop -orient vertical
429 if {[info exists geometry(width)]} {
430 .ctop conf -width $geometry(width) -height $geometry(height)
431 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
432 set geometry(ctexth) [expr {($texth - 8) /
433 [font metrics $textfont -linespace]}]
438 pack .ctop.top.lbar -side bottom -fill x
439 pack .ctop.top.bar -side bottom -fill x
440 set cscroll .ctop.top.csb
441 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
442 pack $cscroll -side right -fill y
443 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
444 pack .ctop.top.clist -side top -fill both -expand 1
446 set canv .ctop.top.clist.canv
447 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
449 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
450 .ctop.top.clist add $canv
451 set canv2 .ctop.top.clist.canv2
452 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
453 -bg white -bd 0 -yscrollincr $linespc
454 .ctop.top.clist add $canv2
455 set canv3 .ctop.top.clist.canv3
456 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
457 -bg white -bd 0 -yscrollincr $linespc
458 .ctop.top.clist add $canv3
459 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
461 set sha1entry .ctop.top.bar.sha1
462 set entries $sha1entry
463 set sha1but .ctop.top.bar.sha1label
464 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
465 -command gotocommit -width 8 -font $uifont
466 $sha1but conf -disabledforeground [$sha1but cget -foreground]
467 pack .ctop.top.bar.sha1label -side left
468 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
469 trace add variable sha1string write sha1change
470 pack $sha1entry -side left -pady 2
472 image create bitmap bm-left -data {
473 #define left_width 16
474 #define left_height 16
475 static unsigned char left_bits[] = {
476 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
477 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
478 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
480 image create bitmap bm-right -data {
481 #define right_width 16
482 #define right_height 16
483 static unsigned char right_bits[] = {
484 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
485 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
486 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
488 button .ctop.top.bar.leftbut -image bm-left -command goback \
489 -state disabled -width 26
490 pack .ctop.top.bar.leftbut -side left -fill y
491 button .ctop.top.bar.rightbut -image bm-right -command goforw \
492 -state disabled -width 26
493 pack .ctop.top.bar.rightbut -side left -fill y
495 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
496 pack .ctop.top.bar.findbut -side left
498 set fstring .ctop.top.bar.findstring
499 lappend entries $fstring
500 entry $fstring -width 30 -font $textfont -textvariable findstring
501 trace add variable findstring write find_change
502 pack $fstring -side left -expand 1 -fill x
504 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
505 findtype Exact IgnCase Regexp]
506 trace add variable findtype write find_change
507 .ctop.top.bar.findtype configure -font $uifont
508 .ctop.top.bar.findtype.menu configure -font $uifont
509 set findloc "All fields"
510 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
511 Comments Author Committer
512 trace add variable findloc write find_change
513 .ctop.top.bar.findloc configure -font $uifont
514 .ctop.top.bar.findloc.menu configure -font $uifont
515 pack .ctop.top.bar.findloc -side right
516 pack .ctop.top.bar.findtype -side right
518 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
520 pack .ctop.top.lbar.flabel -side left -fill y
521 set gdttype "touching paths:"
522 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
523 "adding/removing string:"]
524 trace add variable gdttype write hfiles_change
525 $gm conf -font $uifont
526 .ctop.top.lbar.gdttype conf -font $uifont
527 pack .ctop.top.lbar.gdttype -side left -fill y
528 entry .ctop.top.lbar.fent -width 25 -font $textfont \
529 -textvariable highlight_files
530 trace add variable highlight_files write hfiles_change
531 lappend entries .ctop.top.lbar.fent
532 pack .ctop.top.lbar.fent -side left -fill x -expand 1
533 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
534 pack .ctop.top.lbar.vlabel -side left -fill y
535 global viewhlmenu selectedhlview
536 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
537 $viewhlmenu entryconf 0 -command delvhighlight
538 $viewhlmenu conf -font $uifont
539 .ctop.top.lbar.vhl conf -font $uifont
540 pack .ctop.top.lbar.vhl -side left -fill y
542 panedwindow .ctop.cdet -orient horizontal
544 frame .ctop.cdet.left
545 frame .ctop.cdet.left.bot
546 pack .ctop.cdet.left.bot -side bottom -fill x
547 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
549 pack .ctop.cdet.left.bot.search -side left -padx 5
550 set sstring .ctop.cdet.left.bot.sstring
551 entry $sstring -width 20 -font $textfont -textvariable searchstring
552 lappend entries $sstring
553 trace add variable searchstring write incrsearch
554 pack $sstring -side left -expand 1 -fill x
555 set ctext .ctop.cdet.left.ctext
556 text $ctext -bg white -state disabled -font $textfont \
557 -width $geometry(ctextw) -height $geometry(ctexth) \
558 -yscrollcommand scrolltext -wrap none
559 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
560 pack .ctop.cdet.left.sb -side right -fill y
561 pack $ctext -side left -fill both -expand 1
562 .ctop.cdet add .ctop.cdet.left
564 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
565 $ctext tag conf hunksep -fore blue
566 $ctext tag conf d0 -fore red
567 $ctext tag conf d1 -fore "#00a000"
568 $ctext tag conf m0 -fore red
569 $ctext tag conf m1 -fore blue
570 $ctext tag conf m2 -fore green
571 $ctext tag conf m3 -fore purple
572 $ctext tag conf m4 -fore brown
573 $ctext tag conf m5 -fore "#009090"
574 $ctext tag conf m6 -fore magenta
575 $ctext tag conf m7 -fore "#808000"
576 $ctext tag conf m8 -fore "#009000"
577 $ctext tag conf m9 -fore "#ff0080"
578 $ctext tag conf m10 -fore cyan
579 $ctext tag conf m11 -fore "#b07070"
580 $ctext tag conf m12 -fore "#70b0f0"
581 $ctext tag conf m13 -fore "#70f0b0"
582 $ctext tag conf m14 -fore "#f0b070"
583 $ctext tag conf m15 -fore "#ff70b0"
584 $ctext tag conf mmax -fore darkgrey
586 $ctext tag conf mresult -font [concat $textfont bold]
587 $ctext tag conf msep -font [concat $textfont bold]
588 $ctext tag conf found -back yellow
590 frame .ctop.cdet.right
591 frame .ctop.cdet.right.mode
592 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
593 -command reselectline -variable cmitmode -value "patch"
594 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
595 -command reselectline -variable cmitmode -value "tree"
596 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
597 pack .ctop.cdet.right.mode -side top -fill x
598 set cflist .ctop.cdet.right.cfiles
599 set indent [font measure $mainfont "nn"]
600 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
601 -tabs [list $indent [expr {2 * $indent}]] \
602 -yscrollcommand ".ctop.cdet.right.sb set" \
603 -cursor [. cget -cursor] \
604 -spacing1 1 -spacing3 1
605 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
606 pack .ctop.cdet.right.sb -side right -fill y
607 pack $cflist -side left -fill both -expand 1
608 $cflist tag configure highlight \
609 -background [$cflist cget -selectbackground]
610 $cflist tag configure bold -font [concat $mainfont bold]
611 .ctop.cdet add .ctop.cdet.right
612 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
614 pack .ctop -side top -fill both -expand 1
616 bindall <1> {selcanvline %W %x %y}
617 #bindall <B1-Motion> {selcanvline %W %x %y}
618 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
619 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
620 bindall <2> "canvscan mark %W %x %y"
621 bindall <B2-Motion> "canvscan dragto %W %x %y"
622 bindkey <Home> selfirstline
623 bindkey <End> sellastline
624 bind . <Key-Up> "selnextline -1"
625 bind . <Key-Down> "selnextline 1"
626 bindkey <Key-Right> "goforw"
627 bindkey <Key-Left> "goback"
628 bind . <Key-Prior> "selnextpage -1"
629 bind . <Key-Next> "selnextpage 1"
630 bind . <Control-Home> "allcanvs yview moveto 0.0"
631 bind . <Control-End> "allcanvs yview moveto 1.0"
632 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
633 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
634 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
635 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
636 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
637 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
638 bindkey <Key-space> "$ctext yview scroll 1 pages"
639 bindkey p "selnextline -1"
640 bindkey n "selnextline 1"
643 bindkey i "selnextline -1"
644 bindkey k "selnextline 1"
647 bindkey b "$ctext yview scroll -1 pages"
648 bindkey d "$ctext yview scroll 18 units"
649 bindkey u "$ctext yview scroll -18 units"
650 bindkey / {findnext 1}
651 bindkey <Key-Return> {findnext 0}
654 bind . <Control-q> doquit
655 bind . <Control-f> dofind
656 bind . <Control-g> {findnext 0}
657 bind . <Control-r> dosearchback
658 bind . <Control-s> dosearch
659 bind . <Control-equal> {incrfont 1}
660 bind . <Control-KP_Add> {incrfont 1}
661 bind . <Control-minus> {incrfont -1}
662 bind . <Control-KP_Subtract> {incrfont -1}
663 bind . <Destroy> {savestuff %W}
664 bind . <Button-1> "click %W"
665 bind $fstring <Key-Return> dofind
666 bind $sha1entry <Key-Return> gotocommit
667 bind $sha1entry <<PasteSelection>> clearsha1
668 bind $cflist <1> {sel_flist %W %x %y; break}
669 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
670 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
672 set maincursor [. cget -cursor]
673 set textcursor [$ctext cget -cursor]
674 set curtextcursor $textcursor
676 set rowctxmenu .rowctxmenu
677 menu $rowctxmenu -tearoff 0
678 $rowctxmenu add command -label "Diff this -> selected" \
679 -command {diffvssel 0}
680 $rowctxmenu add command -label "Diff selected -> this" \
681 -command {diffvssel 1}
682 $rowctxmenu add command -label "Make patch" -command mkpatch
683 $rowctxmenu add command -label "Create tag" -command mktag
684 $rowctxmenu add command -label "Write commit to file" -command writecommit
687 # mouse-2 makes all windows scan vertically, but only the one
688 # the cursor is in scans horizontally
689 proc canvscan {op w x y} {
690 global canv canv2 canv3
691 foreach c [list $canv $canv2 $canv3] {
700 proc scrollcanv {cscroll f0 f1} {
706 # when we make a key binding for the toplevel, make sure
707 # it doesn't get triggered when that key is pressed in the
708 # find string entry widget.
709 proc bindkey {ev script} {
712 set escript [bind Entry $ev]
713 if {$escript == {}} {
714 set escript [bind Entry <Key>]
717 bind $e $ev "$escript; break"
721 # set the focus back to the toplevel for any click outside
732 global canv canv2 canv3 ctext cflist mainfont textfont uifont
733 global stuffsaved findmergefiles maxgraphpct
735 global viewname viewfiles viewargs viewperm nextviewnum
738 if {$stuffsaved} return
739 if {![winfo viewable .]} return
741 set f [open "~/.gitk-new" w]
742 puts $f [list set mainfont $mainfont]
743 puts $f [list set textfont $textfont]
744 puts $f [list set uifont $uifont]
745 puts $f [list set findmergefiles $findmergefiles]
746 puts $f [list set maxgraphpct $maxgraphpct]
747 puts $f [list set maxwidth $maxwidth]
748 puts $f [list set cmitmode $cmitmode]
749 puts $f "set geometry(width) [winfo width .ctop]"
750 puts $f "set geometry(height) [winfo height .ctop]"
751 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
752 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
753 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
754 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
755 set wid [expr {([winfo width $ctext] - 8) \
756 / [font measure $textfont "0"]}]
757 puts $f "set geometry(ctextw) $wid"
758 set wid [expr {([winfo width $cflist] - 11) \
759 / [font measure [$cflist cget -font] "0"]}]
760 puts $f "set geometry(cflistw) $wid"
761 puts -nonewline $f "set permviews {"
762 for {set v 0} {$v < $nextviewnum} {incr v} {
764 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
769 file rename -force "~/.gitk-new" "~/.gitk"
774 proc resizeclistpanes {win w} {
776 if {[info exists oldwidth($win)]} {
777 set s0 [$win sash coord 0]
778 set s1 [$win sash coord 1]
780 set sash0 [expr {int($w/2 - 2)}]
781 set sash1 [expr {int($w*5/6 - 2)}]
783 set factor [expr {1.0 * $w / $oldwidth($win)}]
784 set sash0 [expr {int($factor * [lindex $s0 0])}]
785 set sash1 [expr {int($factor * [lindex $s1 0])}]
789 if {$sash1 < $sash0 + 20} {
790 set sash1 [expr {$sash0 + 20}]
792 if {$sash1 > $w - 10} {
793 set sash1 [expr {$w - 10}]
794 if {$sash0 > $sash1 - 20} {
795 set sash0 [expr {$sash1 - 20}]
799 $win sash place 0 $sash0 [lindex $s0 1]
800 $win sash place 1 $sash1 [lindex $s1 1]
802 set oldwidth($win) $w
805 proc resizecdetpanes {win w} {
807 if {[info exists oldwidth($win)]} {
808 set s0 [$win sash coord 0]
810 set sash0 [expr {int($w*3/4 - 2)}]
812 set factor [expr {1.0 * $w / $oldwidth($win)}]
813 set sash0 [expr {int($factor * [lindex $s0 0])}]
817 if {$sash0 > $w - 15} {
818 set sash0 [expr {$w - 15}]
821 $win sash place 0 $sash0 [lindex $s0 1]
823 set oldwidth($win) $w
827 global canv canv2 canv3
833 proc bindall {event action} {
834 global canv canv2 canv3
835 bind $canv $event $action
836 bind $canv2 $event $action
837 bind $canv3 $event $action
842 if {[winfo exists $w]} {
847 wm title $w "About gitk"
849 Gitk - a commit viewer for git
851 Copyright © 2005-2006 Paul Mackerras
853 Use and redistribute under the terms of the GNU General Public License} \
854 -justify center -aspect 400
855 pack $w.m -side top -fill x -padx 20 -pady 20
856 button $w.ok -text Close -command "destroy $w"
857 pack $w.ok -side bottom
862 if {[winfo exists $w]} {
867 wm title $w "Gitk key bindings"
872 <Home> Move to first commit
873 <End> Move to last commit
874 <Up>, p, i Move up one commit
875 <Down>, n, k Move down one commit
876 <Left>, z, j Go back in history list
877 <Right>, x, l Go forward in history list
878 <PageUp> Move up one page in commit list
879 <PageDown> Move down one page in commit list
880 <Ctrl-Home> Scroll to top of commit list
881 <Ctrl-End> Scroll to bottom of commit list
882 <Ctrl-Up> Scroll commit list up one line
883 <Ctrl-Down> Scroll commit list down one line
884 <Ctrl-PageUp> Scroll commit list up one page
885 <Ctrl-PageDown> Scroll commit list down one page
886 <Delete>, b Scroll diff view up one page
887 <Backspace> Scroll diff view up one page
888 <Space> Scroll diff view down one page
889 u Scroll diff view up 18 lines
890 d Scroll diff view down 18 lines
892 <Ctrl-G> Move to next find hit
893 <Ctrl-R> Move to previous find hit
894 <Return> Move to next find hit
895 / Move to next find hit, or redo find
896 ? Move to previous find hit
897 f Scroll diff view to next file
898 <Ctrl-KP+> Increase font size
899 <Ctrl-plus> Increase font size
900 <Ctrl-KP-> Decrease font size
901 <Ctrl-minus> Decrease font size
903 -justify left -bg white -border 2 -relief sunken
904 pack $w.m -side top -fill both
905 button $w.ok -text Close -command "destroy $w"
906 pack $w.ok -side bottom
909 # Procedures for manipulating the file list window at the
910 # bottom right of the overall window.
912 proc treeview {w l openlevs} {
913 global treecontents treediropen treeheight treeparent treeindex
923 set treecontents() {}
924 $w conf -state normal
926 while {[string range $f 0 $prefixend] ne $prefix} {
927 if {$lev <= $openlevs} {
928 $w mark set e:$treeindex($prefix) "end -1c"
929 $w mark gravity e:$treeindex($prefix) left
931 set treeheight($prefix) $ht
932 incr ht [lindex $htstack end]
933 set htstack [lreplace $htstack end end]
934 set prefixend [lindex $prefendstack end]
935 set prefendstack [lreplace $prefendstack end end]
936 set prefix [string range $prefix 0 $prefixend]
939 set tail [string range $f [expr {$prefixend+1}] end]
940 while {[set slash [string first "/" $tail]] >= 0} {
943 lappend prefendstack $prefixend
944 incr prefixend [expr {$slash + 1}]
945 set d [string range $tail 0 $slash]
946 lappend treecontents($prefix) $d
947 set oldprefix $prefix
949 set treecontents($prefix) {}
950 set treeindex($prefix) [incr ix]
951 set treeparent($prefix) $oldprefix
952 set tail [string range $tail [expr {$slash+1}] end]
953 if {$lev <= $openlevs} {
955 set treediropen($prefix) [expr {$lev < $openlevs}]
956 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
957 $w mark set d:$ix "end -1c"
958 $w mark gravity d:$ix left
960 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
962 $w image create end -align center -image $bm -padx 1 \
964 $w insert end $d [highlight_tag $prefix]
965 $w mark set s:$ix "end -1c"
966 $w mark gravity s:$ix left
971 if {$lev <= $openlevs} {
974 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
976 $w insert end $tail [highlight_tag $f]
978 lappend treecontents($prefix) $tail
981 while {$htstack ne {}} {
982 set treeheight($prefix) $ht
983 incr ht [lindex $htstack end]
984 set htstack [lreplace $htstack end end]
986 $w conf -state disabled
990 global treeheight treecontents
995 foreach e $treecontents($prefix) {
1000 if {[string index $e end] eq "/"} {
1001 set n $treeheight($prefix$e)
1013 proc highlight_tree {y prefix} {
1014 global treeheight treecontents cflist
1016 foreach e $treecontents($prefix) {
1018 if {[highlight_tag $path] ne {}} {
1019 $cflist tag add bold $y.0 "$y.0 lineend"
1022 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1023 set y [highlight_tree $y $path]
1029 proc treeclosedir {w dir} {
1030 global treediropen treeheight treeparent treeindex
1032 set ix $treeindex($dir)
1033 $w conf -state normal
1034 $w delete s:$ix e:$ix
1035 set treediropen($dir) 0
1036 $w image configure a:$ix -image tri-rt
1037 $w conf -state disabled
1038 set n [expr {1 - $treeheight($dir)}]
1039 while {$dir ne {}} {
1040 incr treeheight($dir) $n
1041 set dir $treeparent($dir)
1045 proc treeopendir {w dir} {
1046 global treediropen treeheight treeparent treecontents treeindex
1048 set ix $treeindex($dir)
1049 $w conf -state normal
1050 $w image configure a:$ix -image tri-dn
1051 $w mark set e:$ix s:$ix
1052 $w mark gravity e:$ix right
1055 set n [llength $treecontents($dir)]
1056 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1059 incr treeheight($x) $n
1061 foreach e $treecontents($dir) {
1063 if {[string index $e end] eq "/"} {
1064 set iy $treeindex($de)
1065 $w mark set d:$iy e:$ix
1066 $w mark gravity d:$iy left
1067 $w insert e:$ix $str
1068 set treediropen($de) 0
1069 $w image create e:$ix -align center -image tri-rt -padx 1 \
1071 $w insert e:$ix $e [highlight_tag $de]
1072 $w mark set s:$iy e:$ix
1073 $w mark gravity s:$iy left
1074 set treeheight($de) 1
1076 $w insert e:$ix $str
1077 $w insert e:$ix $e [highlight_tag $de]
1080 $w mark gravity e:$ix left
1081 $w conf -state disabled
1082 set treediropen($dir) 1
1083 set top [lindex [split [$w index @0,0] .] 0]
1084 set ht [$w cget -height]
1085 set l [lindex [split [$w index s:$ix] .] 0]
1088 } elseif {$l + $n + 1 > $top + $ht} {
1089 set top [expr {$l + $n + 2 - $ht}]
1097 proc treeclick {w x y} {
1098 global treediropen cmitmode ctext cflist cflist_top
1100 if {$cmitmode ne "tree"} return
1101 if {![info exists cflist_top]} return
1102 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1103 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1104 $cflist tag add highlight $l.0 "$l.0 lineend"
1110 set e [linetoelt $l]
1111 if {[string index $e end] ne "/"} {
1113 } elseif {$treediropen($e)} {
1120 proc setfilelist {id} {
1121 global treefilelist cflist
1123 treeview $cflist $treefilelist($id) 0
1126 image create bitmap tri-rt -background black -foreground blue -data {
1127 #define tri-rt_width 13
1128 #define tri-rt_height 13
1129 static unsigned char tri-rt_bits[] = {
1130 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1131 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1134 #define tri-rt-mask_width 13
1135 #define tri-rt-mask_height 13
1136 static unsigned char tri-rt-mask_bits[] = {
1137 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1138 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1141 image create bitmap tri-dn -background black -foreground blue -data {
1142 #define tri-dn_width 13
1143 #define tri-dn_height 13
1144 static unsigned char tri-dn_bits[] = {
1145 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1146 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1149 #define tri-dn-mask_width 13
1150 #define tri-dn-mask_height 13
1151 static unsigned char tri-dn-mask_bits[] = {
1152 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1153 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1157 proc init_flist {first} {
1158 global cflist cflist_top selectedline difffilestart
1160 $cflist conf -state normal
1161 $cflist delete 0.0 end
1163 $cflist insert end $first
1165 $cflist tag add highlight 1.0 "1.0 lineend"
1167 catch {unset cflist_top}
1169 $cflist conf -state disabled
1170 set difffilestart {}
1173 proc highlight_tag {f} {
1174 global highlight_paths
1176 foreach p $highlight_paths {
1177 if {[string match $p $f]} {
1184 proc highlight_filelist {} {
1185 global cmitmode cflist
1187 $cflist conf -state normal
1188 if {$cmitmode ne "tree"} {
1189 set end [lindex [split [$cflist index end] .] 0]
1190 for {set l 2} {$l < $end} {incr l} {
1191 set line [$cflist get $l.0 "$l.0 lineend"]
1192 if {[highlight_tag $line] ne {}} {
1193 $cflist tag add bold $l.0 "$l.0 lineend"
1199 $cflist conf -state disabled
1202 proc unhighlight_filelist {} {
1205 $cflist conf -state normal
1206 $cflist tag remove bold 1.0 end
1207 $cflist conf -state disabled
1210 proc add_flist {fl} {
1213 $cflist conf -state normal
1215 $cflist insert end "\n"
1216 $cflist insert end $f [highlight_tag $f]
1218 $cflist conf -state disabled
1221 proc sel_flist {w x y} {
1222 global ctext difffilestart cflist cflist_top cmitmode
1224 if {$cmitmode eq "tree"} return
1225 if {![info exists cflist_top]} return
1226 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1227 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1228 $cflist tag add highlight $l.0 "$l.0 lineend"
1233 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1237 # Functions for adding and removing shell-type quoting
1239 proc shellquote {str} {
1240 if {![string match "*\['\"\\ \t]*" $str]} {
1243 if {![string match "*\['\"\\]*" $str]} {
1246 if {![string match "*'*" $str]} {
1249 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1252 proc shellarglist {l} {
1258 append str [shellquote $a]
1263 proc shelldequote {str} {
1268 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1269 append ret [string range $str $used end]
1270 set used [string length $str]
1273 set first [lindex $first 0]
1274 set ch [string index $str $first]
1275 if {$first > $used} {
1276 append ret [string range $str $used [expr {$first - 1}]]
1279 if {$ch eq " " || $ch eq "\t"} break
1282 set first [string first "'" $str $used]
1284 error "unmatched single-quote"
1286 append ret [string range $str $used [expr {$first - 1}]]
1291 if {$used >= [string length $str]} {
1292 error "trailing backslash"
1294 append ret [string index $str $used]
1299 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1300 error "unmatched double-quote"
1302 set first [lindex $first 0]
1303 set ch [string index $str $first]
1304 if {$first > $used} {
1305 append ret [string range $str $used [expr {$first - 1}]]
1308 if {$ch eq "\""} break
1310 append ret [string index $str $used]
1314 return [list $used $ret]
1317 proc shellsplit {str} {
1320 set str [string trimleft $str]
1321 if {$str eq {}} break
1322 set dq [shelldequote $str]
1323 set n [lindex $dq 0]
1324 set word [lindex $dq 1]
1325 set str [string range $str $n end]
1331 # Code to implement multiple views
1333 proc newview {ishighlight} {
1334 global nextviewnum newviewname newviewperm uifont newishighlight
1335 global newviewargs revtreeargs
1337 set newishighlight $ishighlight
1339 if {[winfo exists $top]} {
1343 set newviewname($nextviewnum) "View $nextviewnum"
1344 set newviewperm($nextviewnum) 0
1345 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1346 vieweditor $top $nextviewnum "Gitk view definition"
1351 global viewname viewperm newviewname newviewperm
1352 global viewargs newviewargs
1354 set top .gitkvedit-$curview
1355 if {[winfo exists $top]} {
1359 set newviewname($curview) $viewname($curview)
1360 set newviewperm($curview) $viewperm($curview)
1361 set newviewargs($curview) [shellarglist $viewargs($curview)]
1362 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1365 proc vieweditor {top n title} {
1366 global newviewname newviewperm viewfiles
1370 wm title $top $title
1371 label $top.nl -text "Name" -font $uifont
1372 entry $top.name -width 20 -textvariable newviewname($n)
1373 grid $top.nl $top.name -sticky w -pady 5
1374 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1375 grid $top.perm - -pady 5 -sticky w
1376 message $top.al -aspect 1000 -font $uifont \
1377 -text "Commits to include (arguments to git-rev-list):"
1378 grid $top.al - -sticky w -pady 5
1379 entry $top.args -width 50 -textvariable newviewargs($n) \
1381 grid $top.args - -sticky ew -padx 5
1382 message $top.l -aspect 1000 -font $uifont \
1383 -text "Enter files and directories to include, one per line:"
1384 grid $top.l - -sticky w
1385 text $top.t -width 40 -height 10 -background white
1386 if {[info exists viewfiles($n)]} {
1387 foreach f $viewfiles($n) {
1388 $top.t insert end $f
1389 $top.t insert end "\n"
1391 $top.t delete {end - 1c} end
1392 $top.t mark set insert 0.0
1394 grid $top.t - -sticky ew -padx 5
1396 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1397 button $top.buts.can -text "Cancel" -command [list destroy $top]
1398 grid $top.buts.ok $top.buts.can
1399 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1400 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1401 grid $top.buts - -pady 10 -sticky ew
1405 proc doviewmenu {m first cmd op argv} {
1406 set nmenu [$m index end]
1407 for {set i $first} {$i <= $nmenu} {incr i} {
1408 if {[$m entrycget $i -command] eq $cmd} {
1409 eval $m $op $i $argv
1415 proc allviewmenus {n op args} {
1418 doviewmenu .bar.view 7 [list showview $n] $op $args
1419 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1422 proc newviewok {top n} {
1423 global nextviewnum newviewperm newviewname newishighlight
1424 global viewname viewfiles viewperm selectedview curview
1425 global viewargs newviewargs viewhlmenu
1428 set newargs [shellsplit $newviewargs($n)]
1430 error_popup "Error in commit selection arguments: $err"
1436 foreach f [split [$top.t get 0.0 end] "\n"] {
1437 set ft [string trim $f]
1442 if {![info exists viewfiles($n)]} {
1443 # creating a new view
1445 set viewname($n) $newviewname($n)
1446 set viewperm($n) $newviewperm($n)
1447 set viewfiles($n) $files
1448 set viewargs($n) $newargs
1450 if {!$newishighlight} {
1451 after idle showview $n
1453 after idle addvhighlight $n
1456 # editing an existing view
1457 set viewperm($n) $newviewperm($n)
1458 if {$newviewname($n) ne $viewname($n)} {
1459 set viewname($n) $newviewname($n)
1460 doviewmenu .bar.view 7 [list showview $n] \
1461 entryconf [list -label $viewname($n)]
1462 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1463 entryconf [list -label $viewname($n) -value $viewname($n)]
1465 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1466 set viewfiles($n) $files
1467 set viewargs($n) $newargs
1468 if {$curview == $n} {
1469 after idle updatecommits
1473 catch {destroy $top}
1477 global curview viewdata viewperm hlview selectedhlview
1479 if {$curview == 0} return
1480 if {[info exists hlview] && $hlview == $curview} {
1481 set selectedhlview None
1484 allviewmenus $curview delete
1485 set viewdata($curview) {}
1486 set viewperm($curview) 0
1490 proc addviewmenu {n} {
1491 global viewname viewhlmenu
1493 .bar.view add radiobutton -label $viewname($n) \
1494 -command [list showview $n] -variable selectedview -value $n
1495 $viewhlmenu add radiobutton -label $viewname($n) \
1496 -command [list addvhighlight $n] -variable selectedhlview
1499 proc flatten {var} {
1503 foreach i [array names $var] {
1504 lappend ret $i [set $var\($i\)]
1509 proc unflatten {var l} {
1519 global curview viewdata viewfiles
1520 global displayorder parentlist childlist rowidlist rowoffsets
1521 global colormap rowtextx commitrow nextcolor canvxmax
1522 global numcommits rowrangelist commitlisted idrowranges
1523 global selectedline currentid canv canvy0
1524 global matchinglines treediffs
1525 global pending_select phase
1526 global commitidx rowlaidout rowoptim linesegends
1527 global commfd nextupdate
1529 global vparentlist vchildlist vdisporder vcmitlisted
1530 global hlview selectedhlview
1532 if {$n == $curview} return
1534 if {[info exists selectedline]} {
1535 set selid $currentid
1536 set y [yc $selectedline]
1537 set ymax [lindex [$canv cget -scrollregion] 3]
1538 set span [$canv yview]
1539 set ytop [expr {[lindex $span 0] * $ymax}]
1540 set ybot [expr {[lindex $span 1] * $ymax}]
1541 if {$ytop < $y && $y < $ybot} {
1542 set yscreen [expr {$y - $ytop}]
1544 set yscreen [expr {($ybot - $ytop) / 2}]
1550 if {$curview >= 0} {
1551 set vparentlist($curview) $parentlist
1552 set vchildlist($curview) $childlist
1553 set vdisporder($curview) $displayorder
1554 set vcmitlisted($curview) $commitlisted
1556 set viewdata($curview) \
1557 [list $phase $rowidlist $rowoffsets $rowrangelist \
1558 [flatten idrowranges] [flatten idinlist] \
1559 $rowlaidout $rowoptim $numcommits $linesegends]
1560 } elseif {![info exists viewdata($curview)]
1561 || [lindex $viewdata($curview) 0] ne {}} {
1562 set viewdata($curview) \
1563 [list {} $rowidlist $rowoffsets $rowrangelist]
1566 catch {unset matchinglines}
1567 catch {unset treediffs}
1569 if {[info exists hlview] && $hlview == $n} {
1571 set selectedhlview None
1576 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1577 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1579 if {![info exists viewdata($n)]} {
1580 set pending_select $selid
1586 set phase [lindex $v 0]
1587 set displayorder $vdisporder($n)
1588 set parentlist $vparentlist($n)
1589 set childlist $vchildlist($n)
1590 set commitlisted $vcmitlisted($n)
1591 set rowidlist [lindex $v 1]
1592 set rowoffsets [lindex $v 2]
1593 set rowrangelist [lindex $v 3]
1595 set numcommits [llength $displayorder]
1596 catch {unset idrowranges}
1598 unflatten idrowranges [lindex $v 4]
1599 unflatten idinlist [lindex $v 5]
1600 set rowlaidout [lindex $v 6]
1601 set rowoptim [lindex $v 7]
1602 set numcommits [lindex $v 8]
1603 set linesegends [lindex $v 9]
1606 catch {unset colormap}
1607 catch {unset rowtextx}
1609 set canvxmax [$canv cget -width]
1615 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1616 set row $commitrow($n,$selid)
1617 # try to get the selected row in the same position on the screen
1618 set ymax [lindex [$canv cget -scrollregion] 3]
1619 set ytop [expr {[yc $row] - $yscreen}]
1623 set yf [expr {$ytop * 1.0 / $ymax}]
1625 allcanvs yview moveto $yf
1629 if {$phase eq "getcommits"} {
1630 show_status "Reading commits..."
1632 if {[info exists commfd($n)]} {
1637 } elseif {$numcommits == 0} {
1638 show_status "No commits selected"
1642 # Stuff relating to the highlighting facility
1644 proc ishighlighted {row} {
1645 global vhighlights fhighlights nhighlights
1647 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1648 return $nhighlights($row)
1650 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1651 return $vhighlights($row)
1653 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1654 return $fhighlights($row)
1659 proc bolden {row font} {
1660 global canv linehtag selectedline
1662 $canv itemconf $linehtag($row) -font $font
1663 if {$row == $selectedline} {
1665 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1666 -outline {{}} -tags secsel \
1667 -fill [$canv cget -selectbackground]]
1672 proc bolden_name {row font} {
1673 global canv2 linentag selectedline
1675 $canv2 itemconf $linentag($row) -font $font
1676 if {$row == $selectedline} {
1677 $canv2 delete secsel
1678 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1679 -outline {{}} -tags secsel \
1680 -fill [$canv2 cget -selectbackground]]
1685 proc unbolden {rows} {
1689 if {![ishighlighted $row]} {
1690 bolden $row $mainfont
1695 proc addvhighlight {n} {
1696 global hlview curview viewdata vhl_done vhighlights commitidx
1698 if {[info exists hlview]} {
1702 if {$n != $curview && ![info exists viewdata($n)]} {
1703 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1704 set vparentlist($n) {}
1705 set vchildlist($n) {}
1706 set vdisporder($n) {}
1707 set vcmitlisted($n) {}
1710 set vhl_done $commitidx($hlview)
1711 if {$vhl_done > 0} {
1716 proc delvhighlight {} {
1717 global hlview vhighlights
1720 if {![info exists hlview]} return
1722 set rows [array names vhighlights]
1729 proc vhighlightmore {} {
1730 global hlview vhl_done commitidx vhighlights
1731 global displayorder vdisporder curview mainfont
1733 set font [concat $mainfont bold]
1734 set max $commitidx($hlview)
1735 if {$hlview == $curview} {
1736 set disp $displayorder
1738 set disp $vdisporder($hlview)
1740 set vr [visiblerows]
1741 set r0 [lindex $vr 0]
1742 set r1 [lindex $vr 1]
1743 for {set i $vhl_done} {$i < $max} {incr i} {
1744 set id [lindex $disp $i]
1745 if {[info exists commitrow($curview,$id)]} {
1746 set row $commitrow($curview,$id)
1747 if {$r0 <= $row && $row <= $r1} {
1748 if {![highlighted $row]} {
1751 set vhighlights($row) 1
1758 proc askvhighlight {row id} {
1759 global hlview vhighlights commitrow iddrawn mainfont
1761 if {[info exists commitrow($hlview,$id)]} {
1762 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1763 bolden $row [concat $mainfont bold]
1765 set vhighlights($row) 1
1767 set vhighlights($row) 0
1771 proc hfiles_change {name ix op} {
1772 global highlight_files filehighlight fhighlights fh_serial
1773 global mainfont highlight_paths
1775 if {[info exists filehighlight]} {
1776 # delete previous highlights
1777 catch {close $filehighlight}
1779 set rows [array names fhighlights]
1784 unhighlight_filelist
1786 set highlight_paths {}
1787 after cancel do_file_hl $fh_serial
1789 if {$highlight_files ne {}} {
1790 after 300 do_file_hl $fh_serial
1794 proc makepatterns {l} {
1797 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1798 if {[string index $ee end] eq "/"} {
1808 proc do_file_hl {serial} {
1809 global highlight_files filehighlight highlight_paths gdttype
1811 if {$gdttype eq "touching paths:"} {
1812 if {[catch {set paths [shellsplit $highlight_files]}]} return
1813 set highlight_paths [makepatterns $paths]
1815 set gdtargs [concat -- $paths]
1817 set gdtargs [list "-S$highlight_files"]
1819 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1820 set filehighlight [open $cmd r+]
1821 fconfigure $filehighlight -blocking 0
1822 fileevent $filehighlight readable readfhighlight
1827 proc flushhighlights {} {
1828 global filehighlight
1830 if {[info exists filehighlight]} {
1831 puts $filehighlight ""
1832 flush $filehighlight
1836 proc askfilehighlight {row id} {
1837 global filehighlight fhighlights
1839 set fhighlights($row) 0
1840 puts $filehighlight $id
1843 proc readfhighlight {} {
1844 global filehighlight fhighlights commitrow curview mainfont iddrawn
1846 set n [gets $filehighlight line]
1848 if {[eof $filehighlight]} {
1850 puts "oops, git-diff-tree died"
1851 catch {close $filehighlight}
1856 set line [string trim $line]
1857 if {$line eq {}} return
1858 if {![info exists commitrow($curview,$line)]} return
1859 set row $commitrow($curview,$line)
1860 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1861 bolden $row [concat $mainfont bold]
1863 set fhighlights($row) 1
1866 proc find_change {name ix op} {
1867 global nhighlights mainfont
1868 global findstring findpattern findtype
1870 # delete previous highlights, if any
1871 set rows [array names nhighlights]
1874 if {$nhighlights($row) >= 2} {
1875 bolden_name $row $mainfont
1881 if {$findtype ne "Regexp"} {
1882 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1884 set findpattern "*$e*"
1889 proc askfindhighlight {row id} {
1890 global nhighlights commitinfo iddrawn mainfont
1891 global findstring findtype findloc findpattern
1893 if {![info exists commitinfo($id)]} {
1896 set info $commitinfo($id)
1898 set fldtypes {Headline Author Date Committer CDate Comments}
1899 foreach f $info ty $fldtypes {
1900 if {$findloc ne "All fields" && $findloc ne $ty} {
1903 if {$findtype eq "Regexp"} {
1904 set doesmatch [regexp $findstring $f]
1905 } elseif {$findtype eq "IgnCase"} {
1906 set doesmatch [string match -nocase $findpattern $f]
1908 set doesmatch [string match $findpattern $f]
1911 if {$ty eq "Author"} {
1918 if {[info exists iddrawn($id)]} {
1919 if {$isbold && ![ishighlighted $row]} {
1920 bolden $row [concat $mainfont bold]
1923 bolden_name $row [concat $mainfont bold]
1926 set nhighlights($row) $isbold
1929 # Graph layout functions
1931 proc shortids {ids} {
1934 if {[llength $id] > 1} {
1935 lappend res [shortids $id]
1936 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1937 lappend res [string range $id 0 7]
1945 proc incrange {l x o} {
1948 set e [lindex $l $x]
1950 lset l $x [expr {$e + $o}]
1959 for {} {$n > 0} {incr n -1} {
1965 proc usedinrange {id l1 l2} {
1966 global children commitrow childlist curview
1968 if {[info exists commitrow($curview,$id)]} {
1969 set r $commitrow($curview,$id)
1970 if {$l1 <= $r && $r <= $l2} {
1971 return [expr {$r - $l1 + 1}]
1973 set kids [lindex $childlist $r]
1975 set kids $children($curview,$id)
1978 set r $commitrow($curview,$c)
1979 if {$l1 <= $r && $r <= $l2} {
1980 return [expr {$r - $l1 + 1}]
1986 proc sanity {row {full 0}} {
1987 global rowidlist rowoffsets
1990 set ids [lindex $rowidlist $row]
1993 if {$id eq {}} continue
1994 if {$col < [llength $ids] - 1 &&
1995 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1996 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1998 set o [lindex $rowoffsets $row $col]
2004 if {[lindex $rowidlist $y $x] != $id} {
2005 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2006 puts " id=[shortids $id] check started at row $row"
2007 for {set i $row} {$i >= $y} {incr i -1} {
2008 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2013 set o [lindex $rowoffsets $y $x]
2018 proc makeuparrow {oid x y z} {
2019 global rowidlist rowoffsets uparrowlen idrowranges
2021 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2024 set off0 [lindex $rowoffsets $y]
2025 for {set x0 $x} {1} {incr x0} {
2026 if {$x0 >= [llength $off0]} {
2027 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2030 set z [lindex $off0 $x0]
2036 set z [expr {$x0 - $x}]
2037 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2038 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2040 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2041 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2042 lappend idrowranges($oid) $y
2045 proc initlayout {} {
2046 global rowidlist rowoffsets displayorder commitlisted
2047 global rowlaidout rowoptim
2048 global idinlist rowchk rowrangelist idrowranges
2049 global numcommits canvxmax canv
2051 global parentlist childlist children
2052 global colormap rowtextx
2064 catch {unset idinlist}
2065 catch {unset rowchk}
2068 set canvxmax [$canv cget -width]
2069 catch {unset colormap}
2070 catch {unset rowtextx}
2071 catch {unset idrowranges}
2075 proc setcanvscroll {} {
2076 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2078 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2079 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2080 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2081 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2084 proc visiblerows {} {
2085 global canv numcommits linespc
2087 set ymax [lindex [$canv cget -scrollregion] 3]
2088 if {$ymax eq {} || $ymax == 0} return
2090 set y0 [expr {int([lindex $f 0] * $ymax)}]
2091 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2095 set y1 [expr {int([lindex $f 1] * $ymax)}]
2096 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2097 if {$r1 >= $numcommits} {
2098 set r1 [expr {$numcommits - 1}]
2100 return [list $r0 $r1]
2103 proc layoutmore {} {
2104 global rowlaidout rowoptim commitidx numcommits optim_delay
2105 global uparrowlen curview
2108 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2109 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2110 if {$orow > $rowoptim} {
2111 optimize_rows $rowoptim 0 $orow
2114 set canshow [expr {$rowoptim - $optim_delay}]
2115 if {$canshow > $numcommits} {
2120 proc showstuff {canshow} {
2121 global numcommits commitrow pending_select selectedline
2122 global linesegends idrowranges idrangedrawn curview
2124 if {$numcommits == 0} {
2126 set phase "incrdraw"
2130 set numcommits $canshow
2132 set rows [visiblerows]
2133 set r0 [lindex $rows 0]
2134 set r1 [lindex $rows 1]
2136 for {set r $row} {$r < $canshow} {incr r} {
2137 foreach id [lindex $linesegends [expr {$r+1}]] {
2139 foreach {s e} [rowranges $id] {
2141 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2142 && ![info exists idrangedrawn($id,$i)]} {
2144 set idrangedrawn($id,$i) 1
2149 if {$canshow > $r1} {
2152 while {$row < $canshow} {
2156 if {[info exists pending_select] &&
2157 [info exists commitrow($curview,$pending_select)] &&
2158 $commitrow($curview,$pending_select) < $numcommits} {
2159 selectline $commitrow($curview,$pending_select) 1
2161 if {![info exists selectedline] && ![info exists pending_select]} {
2166 proc layoutrows {row endrow last} {
2167 global rowidlist rowoffsets displayorder
2168 global uparrowlen downarrowlen maxwidth mingaplen
2169 global childlist parentlist
2170 global idrowranges linesegends
2171 global commitidx curview
2172 global idinlist rowchk rowrangelist
2174 set idlist [lindex $rowidlist $row]
2175 set offs [lindex $rowoffsets $row]
2176 while {$row < $endrow} {
2177 set id [lindex $displayorder $row]
2180 foreach p [lindex $parentlist $row] {
2181 if {![info exists idinlist($p)]} {
2183 } elseif {!$idinlist($p)} {
2188 set nev [expr {[llength $idlist] + [llength $newolds]
2189 + [llength $oldolds] - $maxwidth + 1}]
2192 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2193 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2194 set i [lindex $idlist $x]
2195 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2196 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2197 [expr {$row + $uparrowlen + $mingaplen}]]
2199 set idlist [lreplace $idlist $x $x]
2200 set offs [lreplace $offs $x $x]
2201 set offs [incrange $offs $x 1]
2203 set rm1 [expr {$row - 1}]
2205 lappend idrowranges($i) $rm1
2206 if {[incr nev -1] <= 0} break
2209 set rowchk($id) [expr {$row + $r}]
2212 lset rowidlist $row $idlist
2213 lset rowoffsets $row $offs
2215 lappend linesegends $lse
2216 set col [lsearch -exact $idlist $id]
2218 set col [llength $idlist]
2220 lset rowidlist $row $idlist
2222 if {[lindex $childlist $row] ne {}} {
2223 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2227 lset rowoffsets $row $offs
2229 makeuparrow $id $col $row $z
2235 if {[info exists idrowranges($id)]} {
2236 set ranges $idrowranges($id)
2238 unset idrowranges($id)
2240 lappend rowrangelist $ranges
2242 set offs [ntimes [llength $idlist] 0]
2243 set l [llength $newolds]
2244 set idlist [eval lreplace \$idlist $col $col $newolds]
2247 set offs [lrange $offs 0 [expr {$col - 1}]]
2248 foreach x $newolds {
2253 set tmp [expr {[llength $idlist] - [llength $offs]}]
2255 set offs [concat $offs [ntimes $tmp $o]]
2260 foreach i $newolds {
2262 set idrowranges($i) $row
2265 foreach oid $oldolds {
2266 set idinlist($oid) 1
2267 set idlist [linsert $idlist $col $oid]
2268 set offs [linsert $offs $col $o]
2269 makeuparrow $oid $col $row $o
2272 lappend rowidlist $idlist
2273 lappend rowoffsets $offs
2278 proc addextraid {id row} {
2279 global displayorder commitrow commitinfo
2280 global commitidx commitlisted
2281 global parentlist childlist children curview
2283 incr commitidx($curview)
2284 lappend displayorder $id
2285 lappend commitlisted 0
2286 lappend parentlist {}
2287 set commitrow($curview,$id) $row
2289 if {![info exists commitinfo($id)]} {
2290 set commitinfo($id) {"No commit information available"}
2292 if {![info exists children($curview,$id)]} {
2293 set children($curview,$id) {}
2295 lappend childlist $children($curview,$id)
2298 proc layouttail {} {
2299 global rowidlist rowoffsets idinlist commitidx curview
2300 global idrowranges rowrangelist
2302 set row $commitidx($curview)
2303 set idlist [lindex $rowidlist $row]
2304 while {$idlist ne {}} {
2305 set col [expr {[llength $idlist] - 1}]
2306 set id [lindex $idlist $col]
2309 lappend idrowranges($id) $row
2310 lappend rowrangelist $idrowranges($id)
2311 unset idrowranges($id)
2313 set offs [ntimes $col 0]
2314 set idlist [lreplace $idlist $col $col]
2315 lappend rowidlist $idlist
2316 lappend rowoffsets $offs
2319 foreach id [array names idinlist] {
2321 lset rowidlist $row [list $id]
2322 lset rowoffsets $row 0
2323 makeuparrow $id 0 $row 0
2324 lappend idrowranges($id) $row
2325 lappend rowrangelist $idrowranges($id)
2326 unset idrowranges($id)
2328 lappend rowidlist {}
2329 lappend rowoffsets {}
2333 proc insert_pad {row col npad} {
2334 global rowidlist rowoffsets
2336 set pad [ntimes $npad {}]
2337 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2338 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2339 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2342 proc optimize_rows {row col endrow} {
2343 global rowidlist rowoffsets idrowranges displayorder
2345 for {} {$row < $endrow} {incr row} {
2346 set idlist [lindex $rowidlist $row]
2347 set offs [lindex $rowoffsets $row]
2349 for {} {$col < [llength $offs]} {incr col} {
2350 if {[lindex $idlist $col] eq {}} {
2354 set z [lindex $offs $col]
2355 if {$z eq {}} continue
2357 set x0 [expr {$col + $z}]
2358 set y0 [expr {$row - 1}]
2359 set z0 [lindex $rowoffsets $y0 $x0]
2361 set id [lindex $idlist $col]
2362 set ranges [rowranges $id]
2363 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2367 if {$z < -1 || ($z < 0 && $isarrow)} {
2368 set npad [expr {-1 - $z + $isarrow}]
2369 set offs [incrange $offs $col $npad]
2370 insert_pad $y0 $x0 $npad
2372 optimize_rows $y0 $x0 $row
2374 set z [lindex $offs $col]
2375 set x0 [expr {$col + $z}]
2376 set z0 [lindex $rowoffsets $y0 $x0]
2377 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2378 set npad [expr {$z - 1 + $isarrow}]
2379 set y1 [expr {$row + 1}]
2380 set offs2 [lindex $rowoffsets $y1]
2384 if {$z eq {} || $x1 + $z < $col} continue
2385 if {$x1 + $z > $col} {
2388 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2391 set pad [ntimes $npad {}]
2392 set idlist [eval linsert \$idlist $col $pad]
2393 set tmp [eval linsert \$offs $col $pad]
2395 set offs [incrange $tmp $col [expr {-$npad}]]
2396 set z [lindex $offs $col]
2399 if {$z0 eq {} && !$isarrow} {
2400 # this line links to its first child on row $row-2
2401 set rm2 [expr {$row - 2}]
2402 set id [lindex $displayorder $rm2]
2403 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2405 set z0 [expr {$xc - $x0}]
2408 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2409 insert_pad $y0 $x0 1
2410 set offs [incrange $offs $col 1]
2411 optimize_rows $y0 [expr {$x0 + 1}] $row
2416 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2417 set o [lindex $offs $col]
2419 # check if this is the link to the first child
2420 set id [lindex $idlist $col]
2421 set ranges [rowranges $id]
2422 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2423 # it is, work out offset to child
2424 set y0 [expr {$row - 1}]
2425 set id [lindex $displayorder $y0]
2426 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2428 set o [expr {$x0 - $col}]
2432 if {$o eq {} || $o <= 0} break
2434 if {$o ne {} && [incr col] < [llength $idlist]} {
2435 set y1 [expr {$row + 1}]
2436 set offs2 [lindex $rowoffsets $y1]
2440 if {$z eq {} || $x1 + $z < $col} continue
2441 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2444 set idlist [linsert $idlist $col {}]
2445 set tmp [linsert $offs $col {}]
2447 set offs [incrange $tmp $col -1]
2450 lset rowidlist $row $idlist
2451 lset rowoffsets $row $offs
2457 global canvx0 linespc
2458 return [expr {$canvx0 + $col * $linespc}]
2462 global canvy0 linespc
2463 return [expr {$canvy0 + $row * $linespc}]
2466 proc linewidth {id} {
2467 global thickerline lthickness
2470 if {[info exists thickerline] && $id eq $thickerline} {
2471 set wid [expr {2 * $lthickness}]
2476 proc rowranges {id} {
2477 global phase idrowranges commitrow rowlaidout rowrangelist curview
2481 ([info exists commitrow($curview,$id)]
2482 && $commitrow($curview,$id) < $rowlaidout)} {
2483 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2484 } elseif {[info exists idrowranges($id)]} {
2485 set ranges $idrowranges($id)
2490 proc drawlineseg {id i} {
2491 global rowoffsets rowidlist
2493 global canv colormap linespc
2494 global numcommits commitrow curview
2496 set ranges [rowranges $id]
2498 if {[info exists commitrow($curview,$id)]
2499 && $commitrow($curview,$id) < $numcommits} {
2500 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2504 set startrow [lindex $ranges [expr {2 * $i}]]
2505 set row [lindex $ranges [expr {2 * $i + 1}]]
2506 if {$startrow == $row} return
2509 set col [lsearch -exact [lindex $rowidlist $row] $id]
2511 puts "oops: drawline: id $id not on row $row"
2517 set o [lindex $rowoffsets $row $col]
2520 # changing direction
2521 set x [xc $row $col]
2523 lappend coords $x $y
2529 set x [xc $row $col]
2531 lappend coords $x $y
2533 # draw the link to the first child as part of this line
2535 set child [lindex $displayorder $row]
2536 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2538 set x [xc $row $ccol]
2540 if {$ccol < $col - 1} {
2541 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2542 } elseif {$ccol > $col + 1} {
2543 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2545 lappend coords $x $y
2548 if {[llength $coords] < 4} return
2550 # This line has an arrow at the lower end: check if the arrow is
2551 # on a diagonal segment, and if so, work around the Tk 8.4
2552 # refusal to draw arrows on diagonal lines.
2553 set x0 [lindex $coords 0]
2554 set x1 [lindex $coords 2]
2556 set y0 [lindex $coords 1]
2557 set y1 [lindex $coords 3]
2558 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2559 # we have a nearby vertical segment, just trim off the diag bit
2560 set coords [lrange $coords 2 end]
2562 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2563 set xi [expr {$x0 - $slope * $linespc / 2}]
2564 set yi [expr {$y0 - $linespc / 2}]
2565 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2569 set arrow [expr {2 * ($i > 0) + $downarrow}]
2570 set arrow [lindex {none first last both} $arrow]
2571 set t [$canv create line $coords -width [linewidth $id] \
2572 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2577 proc drawparentlinks {id row col olds} {
2578 global rowidlist canv colormap
2580 set row2 [expr {$row + 1}]
2581 set x [xc $row $col]
2584 set ids [lindex $rowidlist $row2]
2585 # rmx = right-most X coord used
2588 set i [lsearch -exact $ids $p]
2590 puts "oops, parent $p of $id not in list"
2593 set x2 [xc $row2 $i]
2597 set ranges [rowranges $p]
2598 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2599 && $row2 < [lindex $ranges 1]} {
2600 # drawlineseg will do this one for us
2604 # should handle duplicated parents here...
2605 set coords [list $x $y]
2606 if {$i < $col - 1} {
2607 lappend coords [xc $row [expr {$i + 1}]] $y
2608 } elseif {$i > $col + 1} {
2609 lappend coords [xc $row [expr {$i - 1}]] $y
2611 lappend coords $x2 $y2
2612 set t [$canv create line $coords -width [linewidth $p] \
2613 -fill $colormap($p) -tags lines.$p]
2620 proc drawlines {id} {
2621 global colormap canv
2623 global children iddrawn commitrow rowidlist curview
2625 $canv delete lines.$id
2626 set nr [expr {[llength [rowranges $id]] / 2}]
2627 for {set i 0} {$i < $nr} {incr i} {
2628 if {[info exists idrangedrawn($id,$i)]} {
2632 foreach child $children($curview,$id) {
2633 if {[info exists iddrawn($child)]} {
2634 set row $commitrow($curview,$child)
2635 set col [lsearch -exact [lindex $rowidlist $row] $child]
2637 drawparentlinks $child $row $col [list $id]
2643 proc drawcmittext {id row col rmx} {
2644 global linespc canv canv2 canv3 canvy0
2645 global commitlisted commitinfo rowidlist
2646 global rowtextx idpos idtags idheads idotherrefs
2647 global linehtag linentag linedtag
2648 global mainfont canvxmax
2650 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2651 set x [xc $row $col]
2653 set orad [expr {$linespc / 3}]
2654 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2655 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2656 -fill $ofill -outline black -width 1]
2658 $canv bind $t <1> {selcanvline {} %x %y}
2659 set xt [xc $row [llength [lindex $rowidlist $row]]]
2663 set rowtextx($row) $xt
2664 set idpos($id) [list $x $xt $y]
2665 if {[info exists idtags($id)] || [info exists idheads($id)]
2666 || [info exists idotherrefs($id)]} {
2667 set xt [drawtags $id $x $xt $y]
2669 set headline [lindex $commitinfo($id) 0]
2670 set name [lindex $commitinfo($id) 1]
2671 set date [lindex $commitinfo($id) 2]
2672 set date [formatdate $date]
2675 set isbold [ishighlighted $row]
2682 set linehtag($row) [$canv create text $xt $y -anchor w \
2683 -text $headline -font $font]
2684 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2685 set linentag($row) [$canv2 create text 3 $y -anchor w \
2686 -text $name -font $nfont]
2687 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2688 -text $date -font $mainfont]
2689 set xr [expr {$xt + [font measure $mainfont $headline]}]
2690 if {$xr > $canvxmax} {
2696 proc drawcmitrow {row} {
2697 global displayorder rowidlist
2698 global idrangedrawn iddrawn
2699 global commitinfo parentlist numcommits
2700 global filehighlight fhighlights findstring nhighlights
2701 global hlview vhighlights
2703 if {$row >= $numcommits} return
2704 foreach id [lindex $rowidlist $row] {
2705 if {$id eq {}} continue
2707 foreach {s e} [rowranges $id] {
2709 if {$row < $s} continue
2712 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2714 set idrangedrawn($id,$i) 1
2721 set id [lindex $displayorder $row]
2722 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2723 askvhighlight $row $id
2725 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2726 askfilehighlight $row $id
2728 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2729 askfindhighlight $row $id
2731 if {[info exists iddrawn($id)]} return
2732 set col [lsearch -exact [lindex $rowidlist $row] $id]
2734 puts "oops, row $row id $id not in list"
2737 if {![info exists commitinfo($id)]} {
2741 set olds [lindex $parentlist $row]
2743 set rmx [drawparentlinks $id $row $col $olds]
2747 drawcmittext $id $row $col $rmx
2751 proc drawfrac {f0 f1} {
2752 global numcommits canv
2755 set ymax [lindex [$canv cget -scrollregion] 3]
2756 if {$ymax eq {} || $ymax == 0} return
2757 set y0 [expr {int($f0 * $ymax)}]
2758 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2762 set y1 [expr {int($f1 * $ymax)}]
2763 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2764 if {$endrow >= $numcommits} {
2765 set endrow [expr {$numcommits - 1}]
2767 for {} {$row <= $endrow} {incr row} {
2772 proc drawvisible {} {
2774 eval drawfrac [$canv yview]
2777 proc clear_display {} {
2778 global iddrawn idrangedrawn
2779 global vhighlights fhighlights nhighlights
2782 catch {unset iddrawn}
2783 catch {unset idrangedrawn}
2784 catch {unset vhighlights}
2785 catch {unset fhighlights}
2786 catch {unset nhighlights}
2789 proc findcrossings {id} {
2790 global rowidlist parentlist numcommits rowoffsets displayorder
2794 foreach {s e} [rowranges $id] {
2795 if {$e >= $numcommits} {
2796 set e [expr {$numcommits - 1}]
2798 if {$e <= $s} continue
2799 set x [lsearch -exact [lindex $rowidlist $e] $id]
2801 puts "findcrossings: oops, no [shortids $id] in row $e"
2804 for {set row $e} {[incr row -1] >= $s} {} {
2805 set olds [lindex $parentlist $row]
2806 set kid [lindex $displayorder $row]
2807 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2808 if {$kidx < 0} continue
2809 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2811 set px [lsearch -exact $nextrow $p]
2812 if {$px < 0} continue
2813 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2814 if {[lsearch -exact $ccross $p] >= 0} continue
2815 if {$x == $px + ($kidx < $px? -1: 1)} {
2817 } elseif {[lsearch -exact $cross $p] < 0} {
2822 set inc [lindex $rowoffsets $row $x]
2823 if {$inc eq {}} break
2827 return [concat $ccross {{}} $cross]
2830 proc assigncolor {id} {
2831 global colormap colors nextcolor
2832 global commitrow parentlist children children curview
2834 if {[info exists colormap($id)]} return
2835 set ncolors [llength $colors]
2836 if {[info exists children($curview,$id)]} {
2837 set kids $children($curview,$id)
2841 if {[llength $kids] == 1} {
2842 set child [lindex $kids 0]
2843 if {[info exists colormap($child)]
2844 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2845 set colormap($id) $colormap($child)
2851 foreach x [findcrossings $id] {
2853 # delimiter between corner crossings and other crossings
2854 if {[llength $badcolors] >= $ncolors - 1} break
2855 set origbad $badcolors
2857 if {[info exists colormap($x)]
2858 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2859 lappend badcolors $colormap($x)
2862 if {[llength $badcolors] >= $ncolors} {
2863 set badcolors $origbad
2865 set origbad $badcolors
2866 if {[llength $badcolors] < $ncolors - 1} {
2867 foreach child $kids {
2868 if {[info exists colormap($child)]
2869 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2870 lappend badcolors $colormap($child)
2872 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2873 if {[info exists colormap($p)]
2874 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2875 lappend badcolors $colormap($p)
2879 if {[llength $badcolors] >= $ncolors} {
2880 set badcolors $origbad
2883 for {set i 0} {$i <= $ncolors} {incr i} {
2884 set c [lindex $colors $nextcolor]
2885 if {[incr nextcolor] >= $ncolors} {
2888 if {[lsearch -exact $badcolors $c]} break
2890 set colormap($id) $c
2893 proc bindline {t id} {
2896 $canv bind $t <Enter> "lineenter %x %y $id"
2897 $canv bind $t <Motion> "linemotion %x %y $id"
2898 $canv bind $t <Leave> "lineleave $id"
2899 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2902 proc drawtags {id x xt y1} {
2903 global idtags idheads idotherrefs
2904 global linespc lthickness
2905 global canv mainfont commitrow rowtextx curview
2910 if {[info exists idtags($id)]} {
2911 set marks $idtags($id)
2912 set ntags [llength $marks]
2914 if {[info exists idheads($id)]} {
2915 set marks [concat $marks $idheads($id)]
2916 set nheads [llength $idheads($id)]
2918 if {[info exists idotherrefs($id)]} {
2919 set marks [concat $marks $idotherrefs($id)]
2925 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2926 set yt [expr {$y1 - 0.5 * $linespc}]
2927 set yb [expr {$yt + $linespc - 1}]
2930 foreach tag $marks {
2931 set wid [font measure $mainfont $tag]
2934 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2936 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2937 -width $lthickness -fill black -tags tag.$id]
2939 foreach tag $marks x $xvals wid $wvals {
2940 set xl [expr {$x + $delta}]
2941 set xr [expr {$x + $delta + $wid + $lthickness}]
2942 if {[incr ntags -1] >= 0} {
2944 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2945 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2946 -width 1 -outline black -fill yellow -tags tag.$id]
2947 $canv bind $t <1> [list showtag $tag 1]
2948 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2950 # draw a head or other ref
2951 if {[incr nheads -1] >= 0} {
2956 set xl [expr {$xl - $delta/2}]
2957 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2958 -width 1 -outline black -fill $col -tags tag.$id
2959 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2960 set rwid [font measure $mainfont $remoteprefix]
2961 set xi [expr {$x + 1}]
2962 set yti [expr {$yt + 1}]
2963 set xri [expr {$x + $rwid}]
2964 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2965 -width 0 -fill "#ffddaa" -tags tag.$id
2968 set t [$canv create text $xl $y1 -anchor w -text $tag \
2969 -font $mainfont -tags tag.$id]
2971 $canv bind $t <1> [list showtag $tag 1]
2977 proc xcoord {i level ln} {
2978 global canvx0 xspc1 xspc2
2980 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2981 if {$i > 0 && $i == $level} {
2982 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2983 } elseif {$i > $level} {
2984 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2989 proc show_status {msg} {
2990 global canv mainfont
2993 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2996 proc finishcommits {} {
2997 global commitidx phase curview
2998 global canv mainfont ctext maincursor textcursor
2999 global findinprogress pending_select
3001 if {$commitidx($curview) > 0} {
3004 show_status "No commits selected"
3007 catch {unset pending_select}
3010 # Don't change the text pane cursor if it is currently the hand cursor,
3011 # showing that we are over a sha1 ID link.
3012 proc settextcursor {c} {
3013 global ctext curtextcursor
3015 if {[$ctext cget -cursor] == $curtextcursor} {
3016 $ctext config -cursor $c
3018 set curtextcursor $c
3021 proc nowbusy {what} {
3024 if {[array names isbusy] eq {}} {
3025 . config -cursor watch
3031 proc notbusy {what} {
3032 global isbusy maincursor textcursor
3034 catch {unset isbusy($what)}
3035 if {[array names isbusy] eq {}} {
3036 . config -cursor $maincursor
3037 settextcursor $textcursor
3044 global canvy0 numcommits linespc
3045 global rowlaidout commitidx curview
3046 global pending_select
3049 layoutrows $rowlaidout $commitidx($curview) 1
3051 optimize_rows $row 0 $commitidx($curview)
3052 showstuff $commitidx($curview)
3053 if {[info exists pending_select]} {
3057 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3058 #puts "overall $drawmsecs ms for $numcommits commits"
3061 proc findmatches {f} {
3062 global findtype foundstring foundstrlen
3063 if {$findtype == "Regexp"} {
3064 set matches [regexp -indices -all -inline $foundstring $f]
3066 if {$findtype == "IgnCase"} {
3067 set str [string tolower $f]
3073 while {[set j [string first $foundstring $str $i]] >= 0} {
3074 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3075 set i [expr {$j + $foundstrlen}]
3082 global findtype findloc findstring markedmatches commitinfo
3083 global numcommits displayorder linehtag linentag linedtag
3084 global mainfont canv canv2 canv3 selectedline
3085 global matchinglines foundstring foundstrlen matchstring
3091 set matchinglines {}
3092 if {$findtype == "IgnCase"} {
3093 set foundstring [string tolower $findstring]
3095 set foundstring $findstring
3097 set foundstrlen [string length $findstring]
3098 if {$foundstrlen == 0} return
3099 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3100 set matchstring "*$matchstring*"
3101 if {![info exists selectedline]} {
3104 set oldsel $selectedline
3107 set fldtypes {Headline Author Date Committer CDate Comments}
3109 foreach id $displayorder {
3110 set d $commitdata($id)
3112 if {$findtype == "Regexp"} {
3113 set doesmatch [regexp $foundstring $d]
3114 } elseif {$findtype == "IgnCase"} {
3115 set doesmatch [string match -nocase $matchstring $d]
3117 set doesmatch [string match $matchstring $d]
3119 if {!$doesmatch} continue
3120 if {![info exists commitinfo($id)]} {
3123 set info $commitinfo($id)
3125 foreach f $info ty $fldtypes {
3126 if {$findloc != "All fields" && $findloc != $ty} {
3129 set matches [findmatches $f]
3130 if {$matches == {}} continue
3132 if {$ty == "Headline"} {
3134 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3135 } elseif {$ty == "Author"} {
3137 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3138 } elseif {$ty == "Date"} {
3140 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3144 lappend matchinglines $l
3145 if {!$didsel && $l > $oldsel} {
3151 if {$matchinglines == {}} {
3153 } elseif {!$didsel} {
3154 findselectline [lindex $matchinglines 0]
3158 proc findselectline {l} {
3159 global findloc commentend ctext
3161 if {$findloc == "All fields" || $findloc == "Comments"} {
3162 # highlight the matches in the comments
3163 set f [$ctext get 1.0 $commentend]
3164 set matches [findmatches $f]
3165 foreach match $matches {
3166 set start [lindex $match 0]
3167 set end [expr {[lindex $match 1] + 1}]
3168 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3173 proc findnext {restart} {
3174 global matchinglines selectedline
3175 if {![info exists matchinglines]} {
3181 if {![info exists selectedline]} return
3182 foreach l $matchinglines {
3183 if {$l > $selectedline} {
3192 global matchinglines selectedline
3193 if {![info exists matchinglines]} {
3197 if {![info exists selectedline]} return
3199 foreach l $matchinglines {
3200 if {$l >= $selectedline} break
3204 findselectline $prev
3210 proc stopfindproc {{done 0}} {
3211 global findprocpid findprocfile findids
3212 global ctext findoldcursor phase maincursor textcursor
3213 global findinprogress
3215 catch {unset findids}
3216 if {[info exists findprocpid]} {
3218 catch {exec kill $findprocpid}
3220 catch {close $findprocfile}
3223 catch {unset findinprogress}
3227 # mark a commit as matching by putting a yellow background
3228 # behind the headline
3229 proc markheadline {l id} {
3230 global canv mainfont linehtag
3233 set bbox [$canv bbox $linehtag($l)]
3234 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3238 # mark the bits of a headline, author or date that match a find string
3239 proc markmatches {canv l str tag matches font} {
3240 set bbox [$canv bbox $tag]
3241 set x0 [lindex $bbox 0]
3242 set y0 [lindex $bbox 1]
3243 set y1 [lindex $bbox 3]
3244 foreach match $matches {
3245 set start [lindex $match 0]
3246 set end [lindex $match 1]
3247 if {$start > $end} continue
3248 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3249 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3250 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3251 [expr {$x0+$xlen+2}] $y1 \
3252 -outline {} -tags matches -fill yellow]
3257 proc unmarkmatches {} {
3258 global matchinglines findids
3259 allcanvs delete matches
3260 catch {unset matchinglines}
3261 catch {unset findids}
3264 proc selcanvline {w x y} {
3265 global canv canvy0 ctext linespc
3267 set ymax [lindex [$canv cget -scrollregion] 3]
3268 if {$ymax == {}} return
3269 set yfrac [lindex [$canv yview] 0]
3270 set y [expr {$y + $yfrac * $ymax}]
3271 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3276 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3282 proc commit_descriptor {p} {
3284 if {![info exists commitinfo($p)]} {
3288 if {[llength $commitinfo($p)] > 1} {
3289 set l [lindex $commitinfo($p) 0]
3294 # append some text to the ctext widget, and make any SHA1 ID
3295 # that we know about be a clickable link.
3296 proc appendwithlinks {text} {
3297 global ctext commitrow linknum curview
3299 set start [$ctext index "end - 1c"]
3300 $ctext insert end $text
3301 $ctext insert end "\n"
3302 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3306 set linkid [string range $text $s $e]
3307 if {![info exists commitrow($curview,$linkid)]} continue
3309 $ctext tag add link "$start + $s c" "$start + $e c"
3310 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3311 $ctext tag bind link$linknum <1> \
3312 [list selectline $commitrow($curview,$linkid) 1]
3315 $ctext tag conf link -foreground blue -underline 1
3316 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3317 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3320 proc viewnextline {dir} {
3324 set ymax [lindex [$canv cget -scrollregion] 3]
3325 set wnow [$canv yview]
3326 set wtop [expr {[lindex $wnow 0] * $ymax}]
3327 set newtop [expr {$wtop + $dir * $linespc}]
3330 } elseif {$newtop > $ymax} {
3333 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3336 proc selectline {l isnew} {
3337 global canv canv2 canv3 ctext commitinfo selectedline
3338 global displayorder linehtag linentag linedtag
3339 global canvy0 linespc parentlist childlist
3340 global currentid sha1entry
3341 global commentend idtags linknum
3342 global mergemax numcommits pending_select
3345 catch {unset pending_select}
3348 if {$l < 0 || $l >= $numcommits} return
3349 set y [expr {$canvy0 + $l * $linespc}]
3350 set ymax [lindex [$canv cget -scrollregion] 3]
3351 set ytop [expr {$y - $linespc - 1}]
3352 set ybot [expr {$y + $linespc + 1}]
3353 set wnow [$canv yview]
3354 set wtop [expr {[lindex $wnow 0] * $ymax}]
3355 set wbot [expr {[lindex $wnow 1] * $ymax}]
3356 set wh [expr {$wbot - $wtop}]
3358 if {$ytop < $wtop} {
3359 if {$ybot < $wtop} {
3360 set newtop [expr {$y - $wh / 2.0}]
3363 if {$newtop > $wtop - $linespc} {
3364 set newtop [expr {$wtop - $linespc}]
3367 } elseif {$ybot > $wbot} {
3368 if {$ytop > $wbot} {
3369 set newtop [expr {$y - $wh / 2.0}]
3371 set newtop [expr {$ybot - $wh}]
3372 if {$newtop < $wtop + $linespc} {
3373 set newtop [expr {$wtop + $linespc}]
3377 if {$newtop != $wtop} {
3381 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3385 if {![info exists linehtag($l)]} return
3387 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3388 -tags secsel -fill [$canv cget -selectbackground]]
3390 $canv2 delete secsel
3391 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3392 -tags secsel -fill [$canv2 cget -selectbackground]]
3394 $canv3 delete secsel
3395 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3396 -tags secsel -fill [$canv3 cget -selectbackground]]
3400 addtohistory [list selectline $l 0]
3405 set id [lindex $displayorder $l]
3407 $sha1entry delete 0 end
3408 $sha1entry insert 0 $id
3409 $sha1entry selection from 0
3410 $sha1entry selection to end
3412 $ctext conf -state normal
3415 set info $commitinfo($id)
3416 set date [formatdate [lindex $info 2]]
3417 $ctext insert end "Author: [lindex $info 1] $date\n"
3418 set date [formatdate [lindex $info 4]]
3419 $ctext insert end "Committer: [lindex $info 3] $date\n"
3420 if {[info exists idtags($id)]} {
3421 $ctext insert end "Tags:"
3422 foreach tag $idtags($id) {
3423 $ctext insert end " $tag"
3425 $ctext insert end "\n"
3429 set olds [lindex $parentlist $l]
3430 if {[llength $olds] > 1} {
3433 if {$np >= $mergemax} {
3438 $ctext insert end "Parent: " $tag
3439 appendwithlinks [commit_descriptor $p]
3444 append comment "Parent: [commit_descriptor $p]\n"
3448 foreach c [lindex $childlist $l] {
3449 append comment "Child: [commit_descriptor $c]\n"
3452 append comment [lindex $info 5]
3454 # make anything that looks like a SHA1 ID be a clickable link
3455 appendwithlinks $comment
3457 $ctext tag delete Comments
3458 $ctext tag remove found 1.0 end
3459 $ctext conf -state disabled
3460 set commentend [$ctext index "end - 1c"]
3462 init_flist "Comments"
3463 if {$cmitmode eq "tree"} {
3465 } elseif {[llength $olds] <= 1} {
3472 proc selfirstline {} {
3477 proc sellastline {} {
3480 set l [expr {$numcommits - 1}]
3484 proc selnextline {dir} {
3486 if {![info exists selectedline]} return
3487 set l [expr {$selectedline + $dir}]
3492 proc selnextpage {dir} {
3493 global canv linespc selectedline numcommits
3495 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3499 allcanvs yview scroll [expr {$dir * $lpp}] units
3501 if {![info exists selectedline]} return
3502 set l [expr {$selectedline + $dir * $lpp}]
3505 } elseif {$l >= $numcommits} {
3506 set l [expr $numcommits - 1]
3512 proc unselectline {} {
3513 global selectedline currentid
3515 catch {unset selectedline}
3516 catch {unset currentid}
3517 allcanvs delete secsel
3520 proc reselectline {} {
3523 if {[info exists selectedline]} {
3524 selectline $selectedline 0
3528 proc addtohistory {cmd} {
3529 global history historyindex curview
3531 set elt [list $curview $cmd]
3532 if {$historyindex > 0
3533 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3537 if {$historyindex < [llength $history]} {
3538 set history [lreplace $history $historyindex end $elt]
3540 lappend history $elt
3543 if {$historyindex > 1} {
3544 .ctop.top.bar.leftbut conf -state normal
3546 .ctop.top.bar.leftbut conf -state disabled
3548 .ctop.top.bar.rightbut conf -state disabled
3554 set view [lindex $elt 0]
3555 set cmd [lindex $elt 1]
3556 if {$curview != $view} {
3563 global history historyindex
3565 if {$historyindex > 1} {
3566 incr historyindex -1
3567 godo [lindex $history [expr {$historyindex - 1}]]
3568 .ctop.top.bar.rightbut conf -state normal
3570 if {$historyindex <= 1} {
3571 .ctop.top.bar.leftbut conf -state disabled
3576 global history historyindex
3578 if {$historyindex < [llength $history]} {
3579 set cmd [lindex $history $historyindex]
3582 .ctop.top.bar.leftbut conf -state normal
3584 if {$historyindex >= [llength $history]} {
3585 .ctop.top.bar.rightbut conf -state disabled
3590 global treefilelist treeidlist diffids diffmergeid treepending
3593 catch {unset diffmergeid}
3594 if {![info exists treefilelist($id)]} {
3595 if {![info exists treepending]} {
3596 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3600 set treefilelist($id) {}
3601 set treeidlist($id) {}
3602 fconfigure $gtf -blocking 0
3603 fileevent $gtf readable [list gettreeline $gtf $id]
3610 proc gettreeline {gtf id} {
3611 global treefilelist treeidlist treepending cmitmode diffids
3613 while {[gets $gtf line] >= 0} {
3614 if {[lindex $line 1] ne "blob"} continue
3615 set sha1 [lindex $line 2]
3616 set fname [lindex $line 3]
3617 lappend treefilelist($id) $fname
3618 lappend treeidlist($id) $sha1
3620 if {![eof $gtf]} return
3623 if {$cmitmode ne "tree"} {
3624 if {![info exists diffmergeid]} {
3625 gettreediffs $diffids
3627 } elseif {$id ne $diffids} {
3635 global treefilelist treeidlist diffids
3636 global ctext commentend
3638 set i [lsearch -exact $treefilelist($diffids) $f]
3640 puts "oops, $f not in list for id $diffids"
3643 set blob [lindex $treeidlist($diffids) $i]
3644 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3645 puts "oops, error reading blob $blob: $err"
3648 fconfigure $bf -blocking 0
3649 fileevent $bf readable [list getblobline $bf $diffids]
3650 $ctext config -state normal
3651 clear_ctext $commentend
3652 $ctext insert end "\n"
3653 $ctext insert end "$f\n" filesep
3654 $ctext config -state disabled
3655 $ctext yview $commentend
3658 proc getblobline {bf id} {
3659 global diffids cmitmode ctext
3661 if {$id ne $diffids || $cmitmode ne "tree"} {
3665 $ctext config -state normal
3666 while {[gets $bf line] >= 0} {
3667 $ctext insert end "$line\n"
3670 # delete last newline
3671 $ctext delete "end - 2c" "end - 1c"
3674 $ctext config -state disabled
3677 proc mergediff {id l} {
3678 global diffmergeid diffopts mdifffd
3684 # this doesn't seem to actually affect anything...
3685 set env(GIT_DIFF_OPTS) $diffopts
3686 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3687 if {[catch {set mdf [open $cmd r]} err]} {
3688 error_popup "Error getting merge diffs: $err"
3691 fconfigure $mdf -blocking 0
3692 set mdifffd($id) $mdf
3693 set np [llength [lindex $parentlist $l]]
3694 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3695 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3698 proc getmergediffline {mdf id np} {
3699 global diffmergeid ctext cflist nextupdate mergemax
3700 global difffilestart mdifffd
3702 set n [gets $mdf line]
3709 if {![info exists diffmergeid] || $id != $diffmergeid
3710 || $mdf != $mdifffd($id)} {
3713 $ctext conf -state normal
3714 if {[regexp {^diff --cc (.*)} $line match fname]} {
3715 # start of a new file
3716 $ctext insert end "\n"
3717 set here [$ctext index "end - 1c"]
3718 lappend difffilestart $here
3719 add_flist [list $fname]
3720 set l [expr {(78 - [string length $fname]) / 2}]
3721 set pad [string range "----------------------------------------" 1 $l]
3722 $ctext insert end "$pad $fname $pad\n" filesep
3723 } elseif {[regexp {^@@} $line]} {
3724 $ctext insert end "$line\n" hunksep
3725 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3728 # parse the prefix - one ' ', '-' or '+' for each parent
3733 for {set j 0} {$j < $np} {incr j} {
3734 set c [string range $line $j $j]
3737 } elseif {$c == "-"} {
3739 } elseif {$c == "+"} {
3748 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3749 # line doesn't appear in result, parents in $minuses have the line
3750 set num [lindex $minuses 0]
3751 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3752 # line appears in result, parents in $pluses don't have the line
3753 lappend tags mresult
3754 set num [lindex $spaces 0]
3757 if {$num >= $mergemax} {
3762 $ctext insert end "$line\n" $tags
3764 $ctext conf -state disabled
3765 if {[clock clicks -milliseconds] >= $nextupdate} {
3767 fileevent $mdf readable {}
3769 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3773 proc startdiff {ids} {
3774 global treediffs diffids treepending diffmergeid
3777 catch {unset diffmergeid}
3778 if {![info exists treediffs($ids)]} {
3779 if {![info exists treepending]} {
3787 proc addtocflist {ids} {
3788 global treediffs cflist
3789 add_flist $treediffs($ids)
3793 proc gettreediffs {ids} {
3794 global treediff treepending
3795 set treepending $ids
3798 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3800 fconfigure $gdtf -blocking 0
3801 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3804 proc gettreediffline {gdtf ids} {
3805 global treediff treediffs treepending diffids diffmergeid
3808 set n [gets $gdtf line]
3810 if {![eof $gdtf]} return
3812 set treediffs($ids) $treediff
3814 if {$cmitmode eq "tree"} {
3816 } elseif {$ids != $diffids} {
3817 if {![info exists diffmergeid]} {
3818 gettreediffs $diffids
3825 set file [lindex $line 5]
3826 lappend treediff $file
3829 proc getblobdiffs {ids} {
3830 global diffopts blobdifffd diffids env curdifftag curtagstart
3831 global nextupdate diffinhdr treediffs
3833 set env(GIT_DIFF_OPTS) $diffopts
3834 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3835 if {[catch {set bdf [open $cmd r]} err]} {
3836 puts "error getting diffs: $err"
3840 fconfigure $bdf -blocking 0
3841 set blobdifffd($ids) $bdf
3842 set curdifftag Comments
3844 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3845 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3848 proc setinlist {var i val} {
3851 while {[llength [set $var]] < $i} {
3854 if {[llength [set $var]] == $i} {
3861 proc getblobdiffline {bdf ids} {
3862 global diffids blobdifffd ctext curdifftag curtagstart
3863 global diffnexthead diffnextnote difffilestart
3864 global nextupdate diffinhdr treediffs
3866 set n [gets $bdf line]
3870 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3871 $ctext tag add $curdifftag $curtagstart end
3876 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3879 $ctext conf -state normal
3880 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3881 # start of a new file
3882 $ctext insert end "\n"
3883 $ctext tag add $curdifftag $curtagstart end
3884 set here [$ctext index "end - 1c"]
3885 set curtagstart $here
3887 set i [lsearch -exact $treediffs($ids) $fname]
3889 setinlist difffilestart $i $here
3891 if {$newname ne $fname} {
3892 set i [lsearch -exact $treediffs($ids) $newname]
3894 setinlist difffilestart $i $here
3897 set curdifftag "f:$fname"
3898 $ctext tag delete $curdifftag
3899 set l [expr {(78 - [string length $header]) / 2}]
3900 set pad [string range "----------------------------------------" 1 $l]
3901 $ctext insert end "$pad $header $pad\n" filesep
3903 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3905 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3907 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3908 $line match f1l f1c f2l f2c rest]} {
3909 $ctext insert end "$line\n" hunksep
3912 set x [string range $line 0 0]
3913 if {$x == "-" || $x == "+"} {
3914 set tag [expr {$x == "+"}]
3915 $ctext insert end "$line\n" d$tag
3916 } elseif {$x == " "} {
3917 $ctext insert end "$line\n"
3918 } elseif {$diffinhdr || $x == "\\"} {
3919 # e.g. "\ No newline at end of file"
3920 $ctext insert end "$line\n" filesep
3922 # Something else we don't recognize
3923 if {$curdifftag != "Comments"} {
3924 $ctext insert end "\n"
3925 $ctext tag add $curdifftag $curtagstart end
3926 set curtagstart [$ctext index "end - 1c"]
3927 set curdifftag Comments
3929 $ctext insert end "$line\n" filesep
3932 $ctext conf -state disabled
3933 if {[clock clicks -milliseconds] >= $nextupdate} {
3935 fileevent $bdf readable {}
3937 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3942 global difffilestart ctext
3943 set here [$ctext index @0,0]
3944 foreach loc $difffilestart {
3945 if {[$ctext compare $loc > $here]} {
3951 proc clear_ctext {{first 1.0}} {
3952 global ctext smarktop smarkbot
3954 set l [lindex [split $first .] 0]
3955 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
3958 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
3961 $ctext delete $first end
3964 proc incrsearch {name ix op} {
3965 global ctext searchstring searchdirn
3967 $ctext tag remove found 1.0 end
3968 if {[catch {$ctext index anchor}]} {
3969 # no anchor set, use start of selection, or of visible area
3970 set sel [$ctext tag ranges sel]
3972 $ctext mark set anchor [lindex $sel 0]
3973 } elseif {$searchdirn eq "-forwards"} {
3974 $ctext mark set anchor @0,0
3976 $ctext mark set anchor @0,[winfo height $ctext]
3979 if {$searchstring ne {}} {
3980 set here [$ctext search $searchdirn -- $searchstring anchor]
3989 global sstring ctext searchstring searchdirn
3992 $sstring icursor end
3993 set searchdirn -forwards
3994 if {$searchstring ne {}} {
3995 set sel [$ctext tag ranges sel]
3997 set start "[lindex $sel 0] + 1c"
3998 } elseif {[catch {set start [$ctext index anchor]}]} {
4001 set match [$ctext search -count mlen -- $searchstring $start]
4002 $ctext tag remove sel 1.0 end
4008 set mend "$match + $mlen c"
4009 $ctext tag add sel $match $mend
4010 $ctext mark unset anchor
4014 proc dosearchback {} {
4015 global sstring ctext searchstring searchdirn
4018 $sstring icursor end
4019 set searchdirn -backwards
4020 if {$searchstring ne {}} {
4021 set sel [$ctext tag ranges sel]
4023 set start [lindex $sel 0]
4024 } elseif {[catch {set start [$ctext index anchor]}]} {
4025 set start @0,[winfo height $ctext]
4027 set match [$ctext search -backwards -count ml -- $searchstring $start]
4028 $ctext tag remove sel 1.0 end
4034 set mend "$match + $ml c"
4035 $ctext tag add sel $match $mend
4036 $ctext mark unset anchor
4040 proc searchmark {first last} {
4041 global ctext searchstring
4045 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4046 if {$match eq {}} break
4047 set mend "$match + $mlen c"
4048 $ctext tag add found $match $mend
4052 proc searchmarkvisible {doall} {
4053 global ctext smarktop smarkbot
4055 set topline [lindex [split [$ctext index @0,0] .] 0]
4056 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4057 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4058 # no overlap with previous
4059 searchmark $topline $botline
4060 set smarktop $topline
4061 set smarkbot $botline
4063 if {$topline < $smarktop} {
4064 searchmark $topline [expr {$smarktop-1}]
4065 set smarktop $topline
4067 if {$botline > $smarkbot} {
4068 searchmark [expr {$smarkbot+1}] $botline
4069 set smarkbot $botline
4074 proc scrolltext {f0 f1} {
4077 .ctop.cdet.left.sb set $f0 $f1
4078 if {$searchstring ne {}} {
4084 global linespc charspc canvx0 canvy0 mainfont
4085 global xspc1 xspc2 lthickness
4087 set linespc [font metrics $mainfont -linespace]
4088 set charspc [font measure $mainfont "m"]
4089 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4090 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4091 set lthickness [expr {int($linespc / 9) + 1}]
4092 set xspc1(0) $linespc
4100 set ymax [lindex [$canv cget -scrollregion] 3]
4101 if {$ymax eq {} || $ymax == 0} return
4102 set span [$canv yview]
4105 allcanvs yview moveto [lindex $span 0]
4107 if {[info exists selectedline]} {
4108 selectline $selectedline 0
4112 proc incrfont {inc} {
4113 global mainfont textfont ctext canv phase
4114 global stopped entries
4116 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4117 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4119 $ctext conf -font $textfont
4120 $ctext tag conf filesep -font [concat $textfont bold]
4121 foreach e $entries {
4122 $e conf -font $mainfont
4124 if {$phase eq "getcommits"} {
4125 $canv itemconf textitems -font $mainfont
4131 global sha1entry sha1string
4132 if {[string length $sha1string] == 40} {
4133 $sha1entry delete 0 end
4137 proc sha1change {n1 n2 op} {
4138 global sha1string currentid sha1but
4139 if {$sha1string == {}
4140 || ([info exists currentid] && $sha1string == $currentid)} {
4145 if {[$sha1but cget -state] == $state} return
4146 if {$state == "normal"} {
4147 $sha1but conf -state normal -relief raised -text "Goto: "
4149 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4153 proc gotocommit {} {
4154 global sha1string currentid commitrow tagids headids
4155 global displayorder numcommits curview
4157 if {$sha1string == {}
4158 || ([info exists currentid] && $sha1string == $currentid)} return
4159 if {[info exists tagids($sha1string)]} {
4160 set id $tagids($sha1string)
4161 } elseif {[info exists headids($sha1string)]} {
4162 set id $headids($sha1string)
4164 set id [string tolower $sha1string]
4165 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4167 foreach i $displayorder {
4168 if {[string match $id* $i]} {
4172 if {$matches ne {}} {
4173 if {[llength $matches] > 1} {
4174 error_popup "Short SHA1 id $id is ambiguous"
4177 set id [lindex $matches 0]
4181 if {[info exists commitrow($curview,$id)]} {
4182 selectline $commitrow($curview,$id) 1
4185 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4190 error_popup "$type $sha1string is not known"
4193 proc lineenter {x y id} {
4194 global hoverx hovery hoverid hovertimer
4195 global commitinfo canv
4197 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4201 if {[info exists hovertimer]} {
4202 after cancel $hovertimer
4204 set hovertimer [after 500 linehover]
4208 proc linemotion {x y id} {
4209 global hoverx hovery hoverid hovertimer
4211 if {[info exists hoverid] && $id == $hoverid} {
4214 if {[info exists hovertimer]} {
4215 after cancel $hovertimer
4217 set hovertimer [after 500 linehover]
4221 proc lineleave {id} {
4222 global hoverid hovertimer canv
4224 if {[info exists hoverid] && $id == $hoverid} {
4226 if {[info exists hovertimer]} {
4227 after cancel $hovertimer
4235 global hoverx hovery hoverid hovertimer
4236 global canv linespc lthickness
4237 global commitinfo mainfont
4239 set text [lindex $commitinfo($hoverid) 0]
4240 set ymax [lindex [$canv cget -scrollregion] 3]
4241 if {$ymax == {}} return
4242 set yfrac [lindex [$canv yview] 0]
4243 set x [expr {$hoverx + 2 * $linespc}]
4244 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4245 set x0 [expr {$x - 2 * $lthickness}]
4246 set y0 [expr {$y - 2 * $lthickness}]
4247 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4248 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4249 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4250 -fill \#ffff80 -outline black -width 1 -tags hover]
4252 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4256 proc clickisonarrow {id y} {
4259 set ranges [rowranges $id]
4260 set thresh [expr {2 * $lthickness + 6}]
4261 set n [expr {[llength $ranges] - 1}]
4262 for {set i 1} {$i < $n} {incr i} {
4263 set row [lindex $ranges $i]
4264 if {abs([yc $row] - $y) < $thresh} {
4271 proc arrowjump {id n y} {
4274 # 1 <-> 2, 3 <-> 4, etc...
4275 set n [expr {(($n - 1) ^ 1) + 1}]
4276 set row [lindex [rowranges $id] $n]
4278 set ymax [lindex [$canv cget -scrollregion] 3]
4279 if {$ymax eq {} || $ymax <= 0} return
4280 set view [$canv yview]
4281 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4282 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4286 allcanvs yview moveto $yfrac
4289 proc lineclick {x y id isnew} {
4290 global ctext commitinfo children canv thickerline curview
4292 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4297 # draw this line thicker than normal
4301 set ymax [lindex [$canv cget -scrollregion] 3]
4302 if {$ymax eq {}} return
4303 set yfrac [lindex [$canv yview] 0]
4304 set y [expr {$y + $yfrac * $ymax}]
4306 set dirn [clickisonarrow $id $y]
4308 arrowjump $id $dirn $y
4313 addtohistory [list lineclick $x $y $id 0]
4315 # fill the details pane with info about this line
4316 $ctext conf -state normal
4318 $ctext tag conf link -foreground blue -underline 1
4319 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4320 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4321 $ctext insert end "Parent:\t"
4322 $ctext insert end $id [list link link0]
4323 $ctext tag bind link0 <1> [list selbyid $id]
4324 set info $commitinfo($id)
4325 $ctext insert end "\n\t[lindex $info 0]\n"
4326 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4327 set date [formatdate [lindex $info 2]]
4328 $ctext insert end "\tDate:\t$date\n"
4329 set kids $children($curview,$id)
4331 $ctext insert end "\nChildren:"
4333 foreach child $kids {
4335 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4336 set info $commitinfo($child)
4337 $ctext insert end "\n\t"
4338 $ctext insert end $child [list link link$i]
4339 $ctext tag bind link$i <1> [list selbyid $child]
4340 $ctext insert end "\n\t[lindex $info 0]"
4341 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4342 set date [formatdate [lindex $info 2]]
4343 $ctext insert end "\n\tDate:\t$date\n"
4346 $ctext conf -state disabled
4350 proc normalline {} {
4352 if {[info exists thickerline]} {
4360 global commitrow curview
4361 if {[info exists commitrow($curview,$id)]} {
4362 selectline $commitrow($curview,$id) 1
4368 if {![info exists startmstime]} {
4369 set startmstime [clock clicks -milliseconds]
4371 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4374 proc rowmenu {x y id} {
4375 global rowctxmenu commitrow selectedline rowmenuid curview
4377 if {![info exists selectedline]
4378 || $commitrow($curview,$id) eq $selectedline} {
4383 $rowctxmenu entryconfigure 0 -state $state
4384 $rowctxmenu entryconfigure 1 -state $state
4385 $rowctxmenu entryconfigure 2 -state $state
4387 tk_popup $rowctxmenu $x $y
4390 proc diffvssel {dirn} {
4391 global rowmenuid selectedline displayorder
4393 if {![info exists selectedline]} return
4395 set oldid [lindex $displayorder $selectedline]
4396 set newid $rowmenuid
4398 set oldid $rowmenuid
4399 set newid [lindex $displayorder $selectedline]
4401 addtohistory [list doseldiff $oldid $newid]
4402 doseldiff $oldid $newid
4405 proc doseldiff {oldid newid} {
4409 $ctext conf -state normal
4412 $ctext insert end "From "
4413 $ctext tag conf link -foreground blue -underline 1
4414 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4415 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4416 $ctext tag bind link0 <1> [list selbyid $oldid]
4417 $ctext insert end $oldid [list link link0]
4418 $ctext insert end "\n "
4419 $ctext insert end [lindex $commitinfo($oldid) 0]
4420 $ctext insert end "\n\nTo "
4421 $ctext tag bind link1 <1> [list selbyid $newid]
4422 $ctext insert end $newid [list link link1]
4423 $ctext insert end "\n "
4424 $ctext insert end [lindex $commitinfo($newid) 0]
4425 $ctext insert end "\n"
4426 $ctext conf -state disabled
4427 $ctext tag delete Comments
4428 $ctext tag remove found 1.0 end
4429 startdiff [list $oldid $newid]
4433 global rowmenuid currentid commitinfo patchtop patchnum
4435 if {![info exists currentid]} return
4436 set oldid $currentid
4437 set oldhead [lindex $commitinfo($oldid) 0]
4438 set newid $rowmenuid
4439 set newhead [lindex $commitinfo($newid) 0]
4442 catch {destroy $top}
4444 label $top.title -text "Generate patch"
4445 grid $top.title - -pady 10
4446 label $top.from -text "From:"
4447 entry $top.fromsha1 -width 40 -relief flat
4448 $top.fromsha1 insert 0 $oldid
4449 $top.fromsha1 conf -state readonly
4450 grid $top.from $top.fromsha1 -sticky w
4451 entry $top.fromhead -width 60 -relief flat
4452 $top.fromhead insert 0 $oldhead
4453 $top.fromhead conf -state readonly
4454 grid x $top.fromhead -sticky w
4455 label $top.to -text "To:"
4456 entry $top.tosha1 -width 40 -relief flat
4457 $top.tosha1 insert 0 $newid
4458 $top.tosha1 conf -state readonly
4459 grid $top.to $top.tosha1 -sticky w
4460 entry $top.tohead -width 60 -relief flat
4461 $top.tohead insert 0 $newhead
4462 $top.tohead conf -state readonly
4463 grid x $top.tohead -sticky w
4464 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4465 grid $top.rev x -pady 10
4466 label $top.flab -text "Output file:"
4467 entry $top.fname -width 60
4468 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4470 grid $top.flab $top.fname -sticky w
4472 button $top.buts.gen -text "Generate" -command mkpatchgo
4473 button $top.buts.can -text "Cancel" -command mkpatchcan
4474 grid $top.buts.gen $top.buts.can
4475 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4476 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4477 grid $top.buts - -pady 10 -sticky ew
4481 proc mkpatchrev {} {
4484 set oldid [$patchtop.fromsha1 get]
4485 set oldhead [$patchtop.fromhead get]
4486 set newid [$patchtop.tosha1 get]
4487 set newhead [$patchtop.tohead get]
4488 foreach e [list fromsha1 fromhead tosha1 tohead] \
4489 v [list $newid $newhead $oldid $oldhead] {
4490 $patchtop.$e conf -state normal
4491 $patchtop.$e delete 0 end
4492 $patchtop.$e insert 0 $v
4493 $patchtop.$e conf -state readonly
4500 set oldid [$patchtop.fromsha1 get]
4501 set newid [$patchtop.tosha1 get]
4502 set fname [$patchtop.fname get]
4503 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4504 error_popup "Error creating patch: $err"
4506 catch {destroy $patchtop}
4510 proc mkpatchcan {} {
4513 catch {destroy $patchtop}
4518 global rowmenuid mktagtop commitinfo
4522 catch {destroy $top}
4524 label $top.title -text "Create tag"
4525 grid $top.title - -pady 10
4526 label $top.id -text "ID:"
4527 entry $top.sha1 -width 40 -relief flat
4528 $top.sha1 insert 0 $rowmenuid
4529 $top.sha1 conf -state readonly
4530 grid $top.id $top.sha1 -sticky w
4531 entry $top.head -width 60 -relief flat
4532 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4533 $top.head conf -state readonly
4534 grid x $top.head -sticky w
4535 label $top.tlab -text "Tag name:"
4536 entry $top.tag -width 60
4537 grid $top.tlab $top.tag -sticky w
4539 button $top.buts.gen -text "Create" -command mktaggo
4540 button $top.buts.can -text "Cancel" -command mktagcan
4541 grid $top.buts.gen $top.buts.can
4542 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4543 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4544 grid $top.buts - -pady 10 -sticky ew
4549 global mktagtop env tagids idtags
4551 set id [$mktagtop.sha1 get]
4552 set tag [$mktagtop.tag get]
4554 error_popup "No tag name specified"
4557 if {[info exists tagids($tag)]} {
4558 error_popup "Tag \"$tag\" already exists"
4563 set fname [file join $dir "refs/tags" $tag]
4564 set f [open $fname w]
4568 error_popup "Error creating tag: $err"
4572 set tagids($tag) $id
4573 lappend idtags($id) $tag
4577 proc redrawtags {id} {
4578 global canv linehtag commitrow idpos selectedline curview
4580 if {![info exists commitrow($curview,$id)]} return
4581 drawcmitrow $commitrow($curview,$id)
4582 $canv delete tag.$id
4583 set xt [eval drawtags $id $idpos($id)]
4584 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4585 if {[info exists selectedline]
4586 && $selectedline == $commitrow($curview,$id)} {
4587 selectline $selectedline 0
4594 catch {destroy $mktagtop}
4603 proc writecommit {} {
4604 global rowmenuid wrcomtop commitinfo wrcomcmd
4606 set top .writecommit
4608 catch {destroy $top}
4610 label $top.title -text "Write commit to file"
4611 grid $top.title - -pady 10
4612 label $top.id -text "ID:"
4613 entry $top.sha1 -width 40 -relief flat
4614 $top.sha1 insert 0 $rowmenuid
4615 $top.sha1 conf -state readonly
4616 grid $top.id $top.sha1 -sticky w
4617 entry $top.head -width 60 -relief flat
4618 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4619 $top.head conf -state readonly
4620 grid x $top.head -sticky w
4621 label $top.clab -text "Command:"
4622 entry $top.cmd -width 60 -textvariable wrcomcmd
4623 grid $top.clab $top.cmd -sticky w -pady 10
4624 label $top.flab -text "Output file:"
4625 entry $top.fname -width 60
4626 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4627 grid $top.flab $top.fname -sticky w
4629 button $top.buts.gen -text "Write" -command wrcomgo
4630 button $top.buts.can -text "Cancel" -command wrcomcan
4631 grid $top.buts.gen $top.buts.can
4632 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4633 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4634 grid $top.buts - -pady 10 -sticky ew
4641 set id [$wrcomtop.sha1 get]
4642 set cmd "echo $id | [$wrcomtop.cmd get]"
4643 set fname [$wrcomtop.fname get]
4644 if {[catch {exec sh -c $cmd >$fname &} err]} {
4645 error_popup "Error writing commit: $err"
4647 catch {destroy $wrcomtop}
4654 catch {destroy $wrcomtop}
4658 proc listrefs {id} {
4659 global idtags idheads idotherrefs
4662 if {[info exists idtags($id)]} {
4666 if {[info exists idheads($id)]} {
4670 if {[info exists idotherrefs($id)]} {
4671 set z $idotherrefs($id)
4673 return [list $x $y $z]
4676 proc rereadrefs {} {
4677 global idtags idheads idotherrefs
4679 set refids [concat [array names idtags] \
4680 [array names idheads] [array names idotherrefs]]
4681 foreach id $refids {
4682 if {![info exists ref($id)]} {
4683 set ref($id) [listrefs $id]
4687 set refids [lsort -unique [concat $refids [array names idtags] \
4688 [array names idheads] [array names idotherrefs]]]
4689 foreach id $refids {
4690 set v [listrefs $id]
4691 if {![info exists ref($id)] || $ref($id) != $v} {
4697 proc showtag {tag isnew} {
4698 global ctext tagcontents tagids linknum
4701 addtohistory [list showtag $tag 0]
4703 $ctext conf -state normal
4706 if {[info exists tagcontents($tag)]} {
4707 set text $tagcontents($tag)
4709 set text "Tag: $tag\nId: $tagids($tag)"
4711 appendwithlinks $text
4712 $ctext conf -state disabled
4723 global maxwidth maxgraphpct diffopts
4724 global oldprefs prefstop
4728 if {[winfo exists $top]} {
4732 foreach v {maxwidth maxgraphpct diffopts} {
4733 set oldprefs($v) [set $v]
4736 wm title $top "Gitk preferences"
4737 label $top.ldisp -text "Commit list display options"
4738 grid $top.ldisp - -sticky w -pady 10
4739 label $top.spacer -text " "
4740 label $top.maxwidthl -text "Maximum graph width (lines)" \
4742 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4743 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4744 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4746 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4747 grid x $top.maxpctl $top.maxpct -sticky w
4748 label $top.ddisp -text "Diff display options"
4749 grid $top.ddisp - -sticky w -pady 10
4750 label $top.diffoptl -text "Options for diff program" \
4752 entry $top.diffopt -width 20 -textvariable diffopts
4753 grid x $top.diffoptl $top.diffopt -sticky w
4755 button $top.buts.ok -text "OK" -command prefsok
4756 button $top.buts.can -text "Cancel" -command prefscan
4757 grid $top.buts.ok $top.buts.can
4758 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4759 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4760 grid $top.buts - - -pady 10 -sticky ew
4764 global maxwidth maxgraphpct diffopts
4765 global oldprefs prefstop
4767 foreach v {maxwidth maxgraphpct diffopts} {
4768 set $v $oldprefs($v)
4770 catch {destroy $prefstop}
4775 global maxwidth maxgraphpct
4776 global oldprefs prefstop
4778 catch {destroy $prefstop}
4780 if {$maxwidth != $oldprefs(maxwidth)
4781 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4786 proc formatdate {d} {
4787 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4790 # This list of encoding names and aliases is distilled from
4791 # http://www.iana.org/assignments/character-sets.
4792 # Not all of them are supported by Tcl.
4793 set encoding_aliases {
4794 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4795 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4796 { ISO-10646-UTF-1 csISO10646UTF1 }
4797 { ISO_646.basic:1983 ref csISO646basic1983 }
4798 { INVARIANT csINVARIANT }
4799 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4800 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4801 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4802 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4803 { NATS-DANO iso-ir-9-1 csNATSDANO }
4804 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4805 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4806 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4807 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4808 { ISO-2022-KR csISO2022KR }
4810 { ISO-2022-JP csISO2022JP }
4811 { ISO-2022-JP-2 csISO2022JP2 }
4812 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4814 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4815 { IT iso-ir-15 ISO646-IT csISO15Italian }
4816 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4817 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4818 { greek7-old iso-ir-18 csISO18Greek7Old }
4819 { latin-greek iso-ir-19 csISO19LatinGreek }
4820 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4821 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4822 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4823 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4824 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4825 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4826 { INIS iso-ir-49 csISO49INIS }
4827 { INIS-8 iso-ir-50 csISO50INIS8 }
4828 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4829 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4830 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4831 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4832 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4833 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4835 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4836 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4837 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4838 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4839 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4840 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4841 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4842 { greek7 iso-ir-88 csISO88Greek7 }
4843 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4844 { iso-ir-90 csISO90 }
4845 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4846 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4847 csISO92JISC62991984b }
4848 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4849 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4850 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4851 csISO95JIS62291984handadd }
4852 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4853 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4854 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4855 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4857 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4858 { T.61-7bit iso-ir-102 csISO102T617bit }
4859 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4860 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4861 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4862 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4863 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4864 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4865 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4866 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4867 arabic csISOLatinArabic }
4868 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4869 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4870 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4871 greek greek8 csISOLatinGreek }
4872 { T.101-G2 iso-ir-128 csISO128T101G2 }
4873 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4875 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4876 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4877 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4878 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4879 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4880 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4881 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4882 csISOLatinCyrillic }
4883 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4884 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4885 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4886 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4887 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4888 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4889 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4890 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4891 { ISO_10367-box iso-ir-155 csISO10367Box }
4892 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4893 { latin-lap lap iso-ir-158 csISO158Lap }
4894 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4895 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4898 { JIS_X0201 X0201 csHalfWidthKatakana }
4899 { KSC5636 ISO646-KR csKSC5636 }
4900 { ISO-10646-UCS-2 csUnicode }
4901 { ISO-10646-UCS-4 csUCS4 }
4902 { DEC-MCS dec csDECMCS }
4903 { hp-roman8 roman8 r8 csHPRoman8 }
4904 { macintosh mac csMacintosh }
4905 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4907 { IBM038 EBCDIC-INT cp038 csIBM038 }
4908 { IBM273 CP273 csIBM273 }
4909 { IBM274 EBCDIC-BE CP274 csIBM274 }
4910 { IBM275 EBCDIC-BR cp275 csIBM275 }
4911 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4912 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4913 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4914 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4915 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4916 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4917 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4918 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4919 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4920 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4921 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4922 { IBM437 cp437 437 csPC8CodePage437 }
4923 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4924 { IBM775 cp775 csPC775Baltic }
4925 { IBM850 cp850 850 csPC850Multilingual }
4926 { IBM851 cp851 851 csIBM851 }
4927 { IBM852 cp852 852 csPCp852 }
4928 { IBM855 cp855 855 csIBM855 }
4929 { IBM857 cp857 857 csIBM857 }
4930 { IBM860 cp860 860 csIBM860 }
4931 { IBM861 cp861 861 cp-is csIBM861 }
4932 { IBM862 cp862 862 csPC862LatinHebrew }
4933 { IBM863 cp863 863 csIBM863 }
4934 { IBM864 cp864 csIBM864 }
4935 { IBM865 cp865 865 csIBM865 }
4936 { IBM866 cp866 866 csIBM866 }
4937 { IBM868 CP868 cp-ar csIBM868 }
4938 { IBM869 cp869 869 cp-gr csIBM869 }
4939 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4940 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4941 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4942 { IBM891 cp891 csIBM891 }
4943 { IBM903 cp903 csIBM903 }
4944 { IBM904 cp904 904 csIBBM904 }
4945 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4946 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4947 { IBM1026 CP1026 csIBM1026 }
4948 { EBCDIC-AT-DE csIBMEBCDICATDE }
4949 { EBCDIC-AT-DE-A csEBCDICATDEA }
4950 { EBCDIC-CA-FR csEBCDICCAFR }
4951 { EBCDIC-DK-NO csEBCDICDKNO }
4952 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4953 { EBCDIC-FI-SE csEBCDICFISE }
4954 { EBCDIC-FI-SE-A csEBCDICFISEA }
4955 { EBCDIC-FR csEBCDICFR }
4956 { EBCDIC-IT csEBCDICIT }
4957 { EBCDIC-PT csEBCDICPT }
4958 { EBCDIC-ES csEBCDICES }
4959 { EBCDIC-ES-A csEBCDICESA }
4960 { EBCDIC-ES-S csEBCDICESS }
4961 { EBCDIC-UK csEBCDICUK }
4962 { EBCDIC-US csEBCDICUS }
4963 { UNKNOWN-8BIT csUnknown8BiT }
4964 { MNEMONIC csMnemonic }
4969 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4970 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4971 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4972 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4973 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4974 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4975 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4976 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4977 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4978 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4979 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4980 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4981 { IBM1047 IBM-1047 }
4982 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4983 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4984 { UNICODE-1-1 csUnicode11 }
4987 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4988 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4990 { ISO-8859-15 ISO_8859-15 Latin-9 }
4991 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4992 { GBK CP936 MS936 windows-936 }
4993 { JIS_Encoding csJISEncoding }
4994 { Shift_JIS MS_Kanji csShiftJIS }
4995 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4997 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4998 { ISO-10646-UCS-Basic csUnicodeASCII }
4999 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5000 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5001 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5002 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5003 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5004 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5005 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5006 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5007 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5008 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5009 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5010 { Ventura-US csVenturaUS }
5011 { Ventura-International csVenturaInternational }
5012 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5013 { PC8-Turkish csPC8Turkish }
5014 { IBM-Symbols csIBMSymbols }
5015 { IBM-Thai csIBMThai }
5016 { HP-Legal csHPLegal }
5017 { HP-Pi-font csHPPiFont }
5018 { HP-Math8 csHPMath8 }
5019 { Adobe-Symbol-Encoding csHPPSMath }
5020 { HP-DeskTop csHPDesktop }
5021 { Ventura-Math csVenturaMath }
5022 { Microsoft-Publishing csMicrosoftPublishing }
5023 { Windows-31J csWindows31J }
5028 proc tcl_encoding {enc} {
5029 global encoding_aliases
5030 set names [encoding names]
5031 set lcnames [string tolower $names]
5032 set enc [string tolower $enc]
5033 set i [lsearch -exact $lcnames $enc]
5035 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5036 if {[regsub {^iso[-_]} $enc iso encx]} {
5037 set i [lsearch -exact $lcnames $encx]
5041 foreach l $encoding_aliases {
5042 set ll [string tolower $l]
5043 if {[lsearch -exact $ll $enc] < 0} continue
5044 # look through the aliases for one that tcl knows about
5046 set i [lsearch -exact $lcnames $e]
5048 if {[regsub {^iso[-_]} $e iso ex]} {
5049 set i [lsearch -exact $lcnames $ex]
5058 return [lindex $names $i]
5065 set diffopts "-U 5 -p"
5066 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5070 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5072 if {$gitencoding == ""} {
5073 set gitencoding "utf-8"
5075 set tclencoding [tcl_encoding $gitencoding]
5076 if {$tclencoding == {}} {
5077 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5080 set mainfont {Helvetica 9}
5081 set textfont {Courier 9}
5082 set uifont {Helvetica 9 bold}
5083 set findmergefiles 0
5091 set cmitmode "patch"
5093 set colors {green red blue magenta darkgrey brown orange}
5095 catch {source ~/.gitk}
5097 font create optionfont -family sans-serif -size -12
5101 switch -regexp -- $arg {
5103 "^-d" { set datemode 1 }
5105 lappend revtreeargs $arg
5110 # check that we can find a .git directory somewhere...
5112 if {![file isdirectory $gitdir]} {
5113 show_error . "Cannot find the git directory \"$gitdir\"."
5117 set cmdline_files {}
5118 set i [lsearch -exact $revtreeargs "--"]
5120 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5121 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5122 } elseif {$revtreeargs ne {}} {
5124 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5125 set cmdline_files [split $f "\n"]
5126 set n [llength $cmdline_files]
5127 set revtreeargs [lrange $revtreeargs 0 end-$n]
5129 # unfortunately we get both stdout and stderr in $err,
5130 # so look for "fatal:".
5131 set i [string first "fatal:" $err]
5133 set err [string range [expr {$i + 6}] end]
5135 show_error . "Bad arguments to gitk:\n$err"
5144 set highlight_paths {}
5145 set searchdirn -forwards
5152 set selectedhlview None
5165 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5166 # create a view for the files/dirs specified on the command line
5170 set viewname(1) "Command line"
5171 set viewfiles(1) $cmdline_files
5172 set viewargs(1) $revtreeargs
5175 .bar.view entryconf 2 -state normal
5176 .bar.view entryconf 3 -state normal
5179 if {[info exists permviews]} {
5180 foreach v $permviews {
5183 set viewname($n) [lindex $v 0]
5184 set viewfiles($n) [lindex $v 1]
5185 set viewargs($n) [lindex $v 2]