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 {[info exists selectedline] && $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 {[info exists selectedline] && $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
1719 if {![info exists hlview]} return
1721 set rows [array names vhighlights]
1728 proc vhighlightmore {} {
1729 global hlview vhl_done commitidx vhighlights
1730 global displayorder vdisporder curview mainfont
1732 set font [concat $mainfont bold]
1733 set max $commitidx($hlview)
1734 if {$hlview == $curview} {
1735 set disp $displayorder
1737 set disp $vdisporder($hlview)
1739 set vr [visiblerows]
1740 set r0 [lindex $vr 0]
1741 set r1 [lindex $vr 1]
1742 for {set i $vhl_done} {$i < $max} {incr i} {
1743 set id [lindex $disp $i]
1744 if {[info exists commitrow($curview,$id)]} {
1745 set row $commitrow($curview,$id)
1746 if {$r0 <= $row && $row <= $r1} {
1747 if {![highlighted $row]} {
1750 set vhighlights($row) 1
1757 proc askvhighlight {row id} {
1758 global hlview vhighlights commitrow iddrawn mainfont
1760 if {[info exists commitrow($hlview,$id)]} {
1761 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1762 bolden $row [concat $mainfont bold]
1764 set vhighlights($row) 1
1766 set vhighlights($row) 0
1770 proc hfiles_change {name ix op} {
1771 global highlight_files filehighlight fhighlights fh_serial
1772 global mainfont highlight_paths
1774 if {[info exists filehighlight]} {
1775 # delete previous highlights
1776 catch {close $filehighlight}
1778 set rows [array names fhighlights]
1783 unhighlight_filelist
1785 set highlight_paths {}
1786 after cancel do_file_hl $fh_serial
1788 if {$highlight_files ne {}} {
1789 after 300 do_file_hl $fh_serial
1793 proc makepatterns {l} {
1796 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1797 if {[string index $ee end] eq "/"} {
1807 proc do_file_hl {serial} {
1808 global highlight_files filehighlight highlight_paths gdttype
1810 if {$gdttype eq "touching paths:"} {
1811 if {[catch {set paths [shellsplit $highlight_files]}]} return
1812 set highlight_paths [makepatterns $paths]
1814 set gdtargs [concat -- $paths]
1816 set gdtargs [list "-S$highlight_files"]
1818 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1819 set filehighlight [open $cmd r+]
1820 fconfigure $filehighlight -blocking 0
1821 fileevent $filehighlight readable readfhighlight
1826 proc flushhighlights {} {
1827 global filehighlight
1829 if {[info exists filehighlight]} {
1830 puts $filehighlight ""
1831 flush $filehighlight
1835 proc askfilehighlight {row id} {
1836 global filehighlight fhighlights
1838 set fhighlights($row) 0
1839 puts $filehighlight $id
1842 proc readfhighlight {} {
1843 global filehighlight fhighlights commitrow curview mainfont iddrawn
1845 set n [gets $filehighlight line]
1847 if {[eof $filehighlight]} {
1849 puts "oops, git-diff-tree died"
1850 catch {close $filehighlight}
1855 set line [string trim $line]
1856 if {$line eq {}} return
1857 if {![info exists commitrow($curview,$line)]} return
1858 set row $commitrow($curview,$line)
1859 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1860 bolden $row [concat $mainfont bold]
1862 set fhighlights($row) 1
1865 proc find_change {name ix op} {
1866 global nhighlights mainfont
1867 global findstring findpattern findtype
1869 # delete previous highlights, if any
1870 set rows [array names nhighlights]
1873 if {$nhighlights($row) >= 2} {
1874 bolden_name $row $mainfont
1880 if {$findtype ne "Regexp"} {
1881 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1883 set findpattern "*$e*"
1888 proc askfindhighlight {row id} {
1889 global nhighlights commitinfo iddrawn mainfont
1890 global findstring findtype findloc findpattern
1892 if {![info exists commitinfo($id)]} {
1895 set info $commitinfo($id)
1897 set fldtypes {Headline Author Date Committer CDate Comments}
1898 foreach f $info ty $fldtypes {
1899 if {$findloc ne "All fields" && $findloc ne $ty} {
1902 if {$findtype eq "Regexp"} {
1903 set doesmatch [regexp $findstring $f]
1904 } elseif {$findtype eq "IgnCase"} {
1905 set doesmatch [string match -nocase $findpattern $f]
1907 set doesmatch [string match $findpattern $f]
1910 if {$ty eq "Author"} {
1917 if {[info exists iddrawn($id)]} {
1918 if {$isbold && ![ishighlighted $row]} {
1919 bolden $row [concat $mainfont bold]
1922 bolden_name $row [concat $mainfont bold]
1925 set nhighlights($row) $isbold
1928 # Graph layout functions
1930 proc shortids {ids} {
1933 if {[llength $id] > 1} {
1934 lappend res [shortids $id]
1935 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1936 lappend res [string range $id 0 7]
1944 proc incrange {l x o} {
1947 set e [lindex $l $x]
1949 lset l $x [expr {$e + $o}]
1958 for {} {$n > 0} {incr n -1} {
1964 proc usedinrange {id l1 l2} {
1965 global children commitrow childlist curview
1967 if {[info exists commitrow($curview,$id)]} {
1968 set r $commitrow($curview,$id)
1969 if {$l1 <= $r && $r <= $l2} {
1970 return [expr {$r - $l1 + 1}]
1972 set kids [lindex $childlist $r]
1974 set kids $children($curview,$id)
1977 set r $commitrow($curview,$c)
1978 if {$l1 <= $r && $r <= $l2} {
1979 return [expr {$r - $l1 + 1}]
1985 proc sanity {row {full 0}} {
1986 global rowidlist rowoffsets
1989 set ids [lindex $rowidlist $row]
1992 if {$id eq {}} continue
1993 if {$col < [llength $ids] - 1 &&
1994 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1995 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1997 set o [lindex $rowoffsets $row $col]
2003 if {[lindex $rowidlist $y $x] != $id} {
2004 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2005 puts " id=[shortids $id] check started at row $row"
2006 for {set i $row} {$i >= $y} {incr i -1} {
2007 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2012 set o [lindex $rowoffsets $y $x]
2017 proc makeuparrow {oid x y z} {
2018 global rowidlist rowoffsets uparrowlen idrowranges
2020 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2023 set off0 [lindex $rowoffsets $y]
2024 for {set x0 $x} {1} {incr x0} {
2025 if {$x0 >= [llength $off0]} {
2026 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2029 set z [lindex $off0 $x0]
2035 set z [expr {$x0 - $x}]
2036 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2037 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2039 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2040 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2041 lappend idrowranges($oid) $y
2044 proc initlayout {} {
2045 global rowidlist rowoffsets displayorder commitlisted
2046 global rowlaidout rowoptim
2047 global idinlist rowchk rowrangelist idrowranges
2048 global numcommits canvxmax canv
2050 global parentlist childlist children
2051 global colormap rowtextx
2063 catch {unset idinlist}
2064 catch {unset rowchk}
2067 set canvxmax [$canv cget -width]
2068 catch {unset colormap}
2069 catch {unset rowtextx}
2070 catch {unset idrowranges}
2074 proc setcanvscroll {} {
2075 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2077 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2078 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2079 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2080 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2083 proc visiblerows {} {
2084 global canv numcommits linespc
2086 set ymax [lindex [$canv cget -scrollregion] 3]
2087 if {$ymax eq {} || $ymax == 0} return
2089 set y0 [expr {int([lindex $f 0] * $ymax)}]
2090 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2094 set y1 [expr {int([lindex $f 1] * $ymax)}]
2095 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2096 if {$r1 >= $numcommits} {
2097 set r1 [expr {$numcommits - 1}]
2099 return [list $r0 $r1]
2102 proc layoutmore {} {
2103 global rowlaidout rowoptim commitidx numcommits optim_delay
2104 global uparrowlen curview
2107 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2108 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2109 if {$orow > $rowoptim} {
2110 optimize_rows $rowoptim 0 $orow
2113 set canshow [expr {$rowoptim - $optim_delay}]
2114 if {$canshow > $numcommits} {
2119 proc showstuff {canshow} {
2120 global numcommits commitrow pending_select selectedline
2121 global linesegends idrowranges idrangedrawn curview
2123 if {$numcommits == 0} {
2125 set phase "incrdraw"
2129 set numcommits $canshow
2131 set rows [visiblerows]
2132 set r0 [lindex $rows 0]
2133 set r1 [lindex $rows 1]
2135 for {set r $row} {$r < $canshow} {incr r} {
2136 foreach id [lindex $linesegends [expr {$r+1}]] {
2138 foreach {s e} [rowranges $id] {
2140 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2141 && ![info exists idrangedrawn($id,$i)]} {
2143 set idrangedrawn($id,$i) 1
2148 if {$canshow > $r1} {
2151 while {$row < $canshow} {
2155 if {[info exists pending_select] &&
2156 [info exists commitrow($curview,$pending_select)] &&
2157 $commitrow($curview,$pending_select) < $numcommits} {
2158 selectline $commitrow($curview,$pending_select) 1
2160 if {![info exists selectedline] && ![info exists pending_select]} {
2165 proc layoutrows {row endrow last} {
2166 global rowidlist rowoffsets displayorder
2167 global uparrowlen downarrowlen maxwidth mingaplen
2168 global childlist parentlist
2169 global idrowranges linesegends
2170 global commitidx curview
2171 global idinlist rowchk rowrangelist
2173 set idlist [lindex $rowidlist $row]
2174 set offs [lindex $rowoffsets $row]
2175 while {$row < $endrow} {
2176 set id [lindex $displayorder $row]
2179 foreach p [lindex $parentlist $row] {
2180 if {![info exists idinlist($p)]} {
2182 } elseif {!$idinlist($p)} {
2187 set nev [expr {[llength $idlist] + [llength $newolds]
2188 + [llength $oldolds] - $maxwidth + 1}]
2191 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2192 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2193 set i [lindex $idlist $x]
2194 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2195 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2196 [expr {$row + $uparrowlen + $mingaplen}]]
2198 set idlist [lreplace $idlist $x $x]
2199 set offs [lreplace $offs $x $x]
2200 set offs [incrange $offs $x 1]
2202 set rm1 [expr {$row - 1}]
2204 lappend idrowranges($i) $rm1
2205 if {[incr nev -1] <= 0} break
2208 set rowchk($id) [expr {$row + $r}]
2211 lset rowidlist $row $idlist
2212 lset rowoffsets $row $offs
2214 lappend linesegends $lse
2215 set col [lsearch -exact $idlist $id]
2217 set col [llength $idlist]
2219 lset rowidlist $row $idlist
2221 if {[lindex $childlist $row] ne {}} {
2222 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2226 lset rowoffsets $row $offs
2228 makeuparrow $id $col $row $z
2234 if {[info exists idrowranges($id)]} {
2235 set ranges $idrowranges($id)
2237 unset idrowranges($id)
2239 lappend rowrangelist $ranges
2241 set offs [ntimes [llength $idlist] 0]
2242 set l [llength $newolds]
2243 set idlist [eval lreplace \$idlist $col $col $newolds]
2246 set offs [lrange $offs 0 [expr {$col - 1}]]
2247 foreach x $newolds {
2252 set tmp [expr {[llength $idlist] - [llength $offs]}]
2254 set offs [concat $offs [ntimes $tmp $o]]
2259 foreach i $newolds {
2261 set idrowranges($i) $row
2264 foreach oid $oldolds {
2265 set idinlist($oid) 1
2266 set idlist [linsert $idlist $col $oid]
2267 set offs [linsert $offs $col $o]
2268 makeuparrow $oid $col $row $o
2271 lappend rowidlist $idlist
2272 lappend rowoffsets $offs
2277 proc addextraid {id row} {
2278 global displayorder commitrow commitinfo
2279 global commitidx commitlisted
2280 global parentlist childlist children curview
2282 incr commitidx($curview)
2283 lappend displayorder $id
2284 lappend commitlisted 0
2285 lappend parentlist {}
2286 set commitrow($curview,$id) $row
2288 if {![info exists commitinfo($id)]} {
2289 set commitinfo($id) {"No commit information available"}
2291 if {![info exists children($curview,$id)]} {
2292 set children($curview,$id) {}
2294 lappend childlist $children($curview,$id)
2297 proc layouttail {} {
2298 global rowidlist rowoffsets idinlist commitidx curview
2299 global idrowranges rowrangelist
2301 set row $commitidx($curview)
2302 set idlist [lindex $rowidlist $row]
2303 while {$idlist ne {}} {
2304 set col [expr {[llength $idlist] - 1}]
2305 set id [lindex $idlist $col]
2308 lappend idrowranges($id) $row
2309 lappend rowrangelist $idrowranges($id)
2310 unset idrowranges($id)
2312 set offs [ntimes $col 0]
2313 set idlist [lreplace $idlist $col $col]
2314 lappend rowidlist $idlist
2315 lappend rowoffsets $offs
2318 foreach id [array names idinlist] {
2320 lset rowidlist $row [list $id]
2321 lset rowoffsets $row 0
2322 makeuparrow $id 0 $row 0
2323 lappend idrowranges($id) $row
2324 lappend rowrangelist $idrowranges($id)
2325 unset idrowranges($id)
2327 lappend rowidlist {}
2328 lappend rowoffsets {}
2332 proc insert_pad {row col npad} {
2333 global rowidlist rowoffsets
2335 set pad [ntimes $npad {}]
2336 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2337 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2338 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2341 proc optimize_rows {row col endrow} {
2342 global rowidlist rowoffsets idrowranges displayorder
2344 for {} {$row < $endrow} {incr row} {
2345 set idlist [lindex $rowidlist $row]
2346 set offs [lindex $rowoffsets $row]
2348 for {} {$col < [llength $offs]} {incr col} {
2349 if {[lindex $idlist $col] eq {}} {
2353 set z [lindex $offs $col]
2354 if {$z eq {}} continue
2356 set x0 [expr {$col + $z}]
2357 set y0 [expr {$row - 1}]
2358 set z0 [lindex $rowoffsets $y0 $x0]
2360 set id [lindex $idlist $col]
2361 set ranges [rowranges $id]
2362 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2366 if {$z < -1 || ($z < 0 && $isarrow)} {
2367 set npad [expr {-1 - $z + $isarrow}]
2368 set offs [incrange $offs $col $npad]
2369 insert_pad $y0 $x0 $npad
2371 optimize_rows $y0 $x0 $row
2373 set z [lindex $offs $col]
2374 set x0 [expr {$col + $z}]
2375 set z0 [lindex $rowoffsets $y0 $x0]
2376 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2377 set npad [expr {$z - 1 + $isarrow}]
2378 set y1 [expr {$row + 1}]
2379 set offs2 [lindex $rowoffsets $y1]
2383 if {$z eq {} || $x1 + $z < $col} continue
2384 if {$x1 + $z > $col} {
2387 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2390 set pad [ntimes $npad {}]
2391 set idlist [eval linsert \$idlist $col $pad]
2392 set tmp [eval linsert \$offs $col $pad]
2394 set offs [incrange $tmp $col [expr {-$npad}]]
2395 set z [lindex $offs $col]
2398 if {$z0 eq {} && !$isarrow} {
2399 # this line links to its first child on row $row-2
2400 set rm2 [expr {$row - 2}]
2401 set id [lindex $displayorder $rm2]
2402 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2404 set z0 [expr {$xc - $x0}]
2407 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2408 insert_pad $y0 $x0 1
2409 set offs [incrange $offs $col 1]
2410 optimize_rows $y0 [expr {$x0 + 1}] $row
2415 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2416 set o [lindex $offs $col]
2418 # check if this is the link to the first child
2419 set id [lindex $idlist $col]
2420 set ranges [rowranges $id]
2421 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2422 # it is, work out offset to child
2423 set y0 [expr {$row - 1}]
2424 set id [lindex $displayorder $y0]
2425 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2427 set o [expr {$x0 - $col}]
2431 if {$o eq {} || $o <= 0} break
2433 if {$o ne {} && [incr col] < [llength $idlist]} {
2434 set y1 [expr {$row + 1}]
2435 set offs2 [lindex $rowoffsets $y1]
2439 if {$z eq {} || $x1 + $z < $col} continue
2440 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2443 set idlist [linsert $idlist $col {}]
2444 set tmp [linsert $offs $col {}]
2446 set offs [incrange $tmp $col -1]
2449 lset rowidlist $row $idlist
2450 lset rowoffsets $row $offs
2456 global canvx0 linespc
2457 return [expr {$canvx0 + $col * $linespc}]
2461 global canvy0 linespc
2462 return [expr {$canvy0 + $row * $linespc}]
2465 proc linewidth {id} {
2466 global thickerline lthickness
2469 if {[info exists thickerline] && $id eq $thickerline} {
2470 set wid [expr {2 * $lthickness}]
2475 proc rowranges {id} {
2476 global phase idrowranges commitrow rowlaidout rowrangelist curview
2480 ([info exists commitrow($curview,$id)]
2481 && $commitrow($curview,$id) < $rowlaidout)} {
2482 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2483 } elseif {[info exists idrowranges($id)]} {
2484 set ranges $idrowranges($id)
2489 proc drawlineseg {id i} {
2490 global rowoffsets rowidlist
2492 global canv colormap linespc
2493 global numcommits commitrow curview
2495 set ranges [rowranges $id]
2497 if {[info exists commitrow($curview,$id)]
2498 && $commitrow($curview,$id) < $numcommits} {
2499 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2503 set startrow [lindex $ranges [expr {2 * $i}]]
2504 set row [lindex $ranges [expr {2 * $i + 1}]]
2505 if {$startrow == $row} return
2508 set col [lsearch -exact [lindex $rowidlist $row] $id]
2510 puts "oops: drawline: id $id not on row $row"
2516 set o [lindex $rowoffsets $row $col]
2519 # changing direction
2520 set x [xc $row $col]
2522 lappend coords $x $y
2528 set x [xc $row $col]
2530 lappend coords $x $y
2532 # draw the link to the first child as part of this line
2534 set child [lindex $displayorder $row]
2535 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2537 set x [xc $row $ccol]
2539 if {$ccol < $col - 1} {
2540 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2541 } elseif {$ccol > $col + 1} {
2542 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2544 lappend coords $x $y
2547 if {[llength $coords] < 4} return
2549 # This line has an arrow at the lower end: check if the arrow is
2550 # on a diagonal segment, and if so, work around the Tk 8.4
2551 # refusal to draw arrows on diagonal lines.
2552 set x0 [lindex $coords 0]
2553 set x1 [lindex $coords 2]
2555 set y0 [lindex $coords 1]
2556 set y1 [lindex $coords 3]
2557 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2558 # we have a nearby vertical segment, just trim off the diag bit
2559 set coords [lrange $coords 2 end]
2561 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2562 set xi [expr {$x0 - $slope * $linespc / 2}]
2563 set yi [expr {$y0 - $linespc / 2}]
2564 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2568 set arrow [expr {2 * ($i > 0) + $downarrow}]
2569 set arrow [lindex {none first last both} $arrow]
2570 set t [$canv create line $coords -width [linewidth $id] \
2571 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2576 proc drawparentlinks {id row col olds} {
2577 global rowidlist canv colormap
2579 set row2 [expr {$row + 1}]
2580 set x [xc $row $col]
2583 set ids [lindex $rowidlist $row2]
2584 # rmx = right-most X coord used
2587 set i [lsearch -exact $ids $p]
2589 puts "oops, parent $p of $id not in list"
2592 set x2 [xc $row2 $i]
2596 set ranges [rowranges $p]
2597 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2598 && $row2 < [lindex $ranges 1]} {
2599 # drawlineseg will do this one for us
2603 # should handle duplicated parents here...
2604 set coords [list $x $y]
2605 if {$i < $col - 1} {
2606 lappend coords [xc $row [expr {$i + 1}]] $y
2607 } elseif {$i > $col + 1} {
2608 lappend coords [xc $row [expr {$i - 1}]] $y
2610 lappend coords $x2 $y2
2611 set t [$canv create line $coords -width [linewidth $p] \
2612 -fill $colormap($p) -tags lines.$p]
2619 proc drawlines {id} {
2620 global colormap canv
2622 global children iddrawn commitrow rowidlist curview
2624 $canv delete lines.$id
2625 set nr [expr {[llength [rowranges $id]] / 2}]
2626 for {set i 0} {$i < $nr} {incr i} {
2627 if {[info exists idrangedrawn($id,$i)]} {
2631 foreach child $children($curview,$id) {
2632 if {[info exists iddrawn($child)]} {
2633 set row $commitrow($curview,$child)
2634 set col [lsearch -exact [lindex $rowidlist $row] $child]
2636 drawparentlinks $child $row $col [list $id]
2642 proc drawcmittext {id row col rmx} {
2643 global linespc canv canv2 canv3 canvy0
2644 global commitlisted commitinfo rowidlist
2645 global rowtextx idpos idtags idheads idotherrefs
2646 global linehtag linentag linedtag
2647 global mainfont canvxmax
2649 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2650 set x [xc $row $col]
2652 set orad [expr {$linespc / 3}]
2653 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2654 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2655 -fill $ofill -outline black -width 1]
2657 $canv bind $t <1> {selcanvline {} %x %y}
2658 set xt [xc $row [llength [lindex $rowidlist $row]]]
2662 set rowtextx($row) $xt
2663 set idpos($id) [list $x $xt $y]
2664 if {[info exists idtags($id)] || [info exists idheads($id)]
2665 || [info exists idotherrefs($id)]} {
2666 set xt [drawtags $id $x $xt $y]
2668 set headline [lindex $commitinfo($id) 0]
2669 set name [lindex $commitinfo($id) 1]
2670 set date [lindex $commitinfo($id) 2]
2671 set date [formatdate $date]
2674 set isbold [ishighlighted $row]
2681 set linehtag($row) [$canv create text $xt $y -anchor w \
2682 -text $headline -font $font]
2683 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2684 set linentag($row) [$canv2 create text 3 $y -anchor w \
2685 -text $name -font $nfont]
2686 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2687 -text $date -font $mainfont]
2688 set xr [expr {$xt + [font measure $mainfont $headline]}]
2689 if {$xr > $canvxmax} {
2695 proc drawcmitrow {row} {
2696 global displayorder rowidlist
2697 global idrangedrawn iddrawn
2698 global commitinfo parentlist numcommits
2699 global filehighlight fhighlights findstring nhighlights
2700 global hlview vhighlights
2702 if {$row >= $numcommits} return
2703 foreach id [lindex $rowidlist $row] {
2704 if {$id eq {}} continue
2706 foreach {s e} [rowranges $id] {
2708 if {$row < $s} continue
2711 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2713 set idrangedrawn($id,$i) 1
2720 set id [lindex $displayorder $row]
2721 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2722 askvhighlight $row $id
2724 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2725 askfilehighlight $row $id
2727 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2728 askfindhighlight $row $id
2730 if {[info exists iddrawn($id)]} return
2731 set col [lsearch -exact [lindex $rowidlist $row] $id]
2733 puts "oops, row $row id $id not in list"
2736 if {![info exists commitinfo($id)]} {
2740 set olds [lindex $parentlist $row]
2742 set rmx [drawparentlinks $id $row $col $olds]
2746 drawcmittext $id $row $col $rmx
2750 proc drawfrac {f0 f1} {
2751 global numcommits canv
2754 set ymax [lindex [$canv cget -scrollregion] 3]
2755 if {$ymax eq {} || $ymax == 0} return
2756 set y0 [expr {int($f0 * $ymax)}]
2757 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2761 set y1 [expr {int($f1 * $ymax)}]
2762 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2763 if {$endrow >= $numcommits} {
2764 set endrow [expr {$numcommits - 1}]
2766 for {} {$row <= $endrow} {incr row} {
2771 proc drawvisible {} {
2773 eval drawfrac [$canv yview]
2776 proc clear_display {} {
2777 global iddrawn idrangedrawn
2778 global vhighlights fhighlights nhighlights
2781 catch {unset iddrawn}
2782 catch {unset idrangedrawn}
2783 catch {unset vhighlights}
2784 catch {unset fhighlights}
2785 catch {unset nhighlights}
2788 proc findcrossings {id} {
2789 global rowidlist parentlist numcommits rowoffsets displayorder
2793 foreach {s e} [rowranges $id] {
2794 if {$e >= $numcommits} {
2795 set e [expr {$numcommits - 1}]
2797 if {$e <= $s} continue
2798 set x [lsearch -exact [lindex $rowidlist $e] $id]
2800 puts "findcrossings: oops, no [shortids $id] in row $e"
2803 for {set row $e} {[incr row -1] >= $s} {} {
2804 set olds [lindex $parentlist $row]
2805 set kid [lindex $displayorder $row]
2806 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2807 if {$kidx < 0} continue
2808 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2810 set px [lsearch -exact $nextrow $p]
2811 if {$px < 0} continue
2812 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2813 if {[lsearch -exact $ccross $p] >= 0} continue
2814 if {$x == $px + ($kidx < $px? -1: 1)} {
2816 } elseif {[lsearch -exact $cross $p] < 0} {
2821 set inc [lindex $rowoffsets $row $x]
2822 if {$inc eq {}} break
2826 return [concat $ccross {{}} $cross]
2829 proc assigncolor {id} {
2830 global colormap colors nextcolor
2831 global commitrow parentlist children children curview
2833 if {[info exists colormap($id)]} return
2834 set ncolors [llength $colors]
2835 if {[info exists children($curview,$id)]} {
2836 set kids $children($curview,$id)
2840 if {[llength $kids] == 1} {
2841 set child [lindex $kids 0]
2842 if {[info exists colormap($child)]
2843 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2844 set colormap($id) $colormap($child)
2850 foreach x [findcrossings $id] {
2852 # delimiter between corner crossings and other crossings
2853 if {[llength $badcolors] >= $ncolors - 1} break
2854 set origbad $badcolors
2856 if {[info exists colormap($x)]
2857 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2858 lappend badcolors $colormap($x)
2861 if {[llength $badcolors] >= $ncolors} {
2862 set badcolors $origbad
2864 set origbad $badcolors
2865 if {[llength $badcolors] < $ncolors - 1} {
2866 foreach child $kids {
2867 if {[info exists colormap($child)]
2868 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2869 lappend badcolors $colormap($child)
2871 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2872 if {[info exists colormap($p)]
2873 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2874 lappend badcolors $colormap($p)
2878 if {[llength $badcolors] >= $ncolors} {
2879 set badcolors $origbad
2882 for {set i 0} {$i <= $ncolors} {incr i} {
2883 set c [lindex $colors $nextcolor]
2884 if {[incr nextcolor] >= $ncolors} {
2887 if {[lsearch -exact $badcolors $c]} break
2889 set colormap($id) $c
2892 proc bindline {t id} {
2895 $canv bind $t <Enter> "lineenter %x %y $id"
2896 $canv bind $t <Motion> "linemotion %x %y $id"
2897 $canv bind $t <Leave> "lineleave $id"
2898 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2901 proc drawtags {id x xt y1} {
2902 global idtags idheads idotherrefs
2903 global linespc lthickness
2904 global canv mainfont commitrow rowtextx curview
2909 if {[info exists idtags($id)]} {
2910 set marks $idtags($id)
2911 set ntags [llength $marks]
2913 if {[info exists idheads($id)]} {
2914 set marks [concat $marks $idheads($id)]
2915 set nheads [llength $idheads($id)]
2917 if {[info exists idotherrefs($id)]} {
2918 set marks [concat $marks $idotherrefs($id)]
2924 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2925 set yt [expr {$y1 - 0.5 * $linespc}]
2926 set yb [expr {$yt + $linespc - 1}]
2929 foreach tag $marks {
2930 set wid [font measure $mainfont $tag]
2933 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2935 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2936 -width $lthickness -fill black -tags tag.$id]
2938 foreach tag $marks x $xvals wid $wvals {
2939 set xl [expr {$x + $delta}]
2940 set xr [expr {$x + $delta + $wid + $lthickness}]
2941 if {[incr ntags -1] >= 0} {
2943 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2944 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2945 -width 1 -outline black -fill yellow -tags tag.$id]
2946 $canv bind $t <1> [list showtag $tag 1]
2947 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2949 # draw a head or other ref
2950 if {[incr nheads -1] >= 0} {
2955 set xl [expr {$xl - $delta/2}]
2956 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2957 -width 1 -outline black -fill $col -tags tag.$id
2958 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2959 set rwid [font measure $mainfont $remoteprefix]
2960 set xi [expr {$x + 1}]
2961 set yti [expr {$yt + 1}]
2962 set xri [expr {$x + $rwid}]
2963 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2964 -width 0 -fill "#ffddaa" -tags tag.$id
2967 set t [$canv create text $xl $y1 -anchor w -text $tag \
2968 -font $mainfont -tags tag.$id]
2970 $canv bind $t <1> [list showtag $tag 1]
2976 proc xcoord {i level ln} {
2977 global canvx0 xspc1 xspc2
2979 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2980 if {$i > 0 && $i == $level} {
2981 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2982 } elseif {$i > $level} {
2983 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2988 proc show_status {msg} {
2989 global canv mainfont
2992 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2995 proc finishcommits {} {
2996 global commitidx phase curview
2997 global canv mainfont ctext maincursor textcursor
2998 global findinprogress pending_select
3000 if {$commitidx($curview) > 0} {
3003 show_status "No commits selected"
3006 catch {unset pending_select}
3009 # Don't change the text pane cursor if it is currently the hand cursor,
3010 # showing that we are over a sha1 ID link.
3011 proc settextcursor {c} {
3012 global ctext curtextcursor
3014 if {[$ctext cget -cursor] == $curtextcursor} {
3015 $ctext config -cursor $c
3017 set curtextcursor $c
3020 proc nowbusy {what} {
3023 if {[array names isbusy] eq {}} {
3024 . config -cursor watch
3030 proc notbusy {what} {
3031 global isbusy maincursor textcursor
3033 catch {unset isbusy($what)}
3034 if {[array names isbusy] eq {}} {
3035 . config -cursor $maincursor
3036 settextcursor $textcursor
3043 global canvy0 numcommits linespc
3044 global rowlaidout commitidx curview
3045 global pending_select
3048 layoutrows $rowlaidout $commitidx($curview) 1
3050 optimize_rows $row 0 $commitidx($curview)
3051 showstuff $commitidx($curview)
3052 if {[info exists pending_select]} {
3056 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3057 #puts "overall $drawmsecs ms for $numcommits commits"
3060 proc findmatches {f} {
3061 global findtype foundstring foundstrlen
3062 if {$findtype == "Regexp"} {
3063 set matches [regexp -indices -all -inline $foundstring $f]
3065 if {$findtype == "IgnCase"} {
3066 set str [string tolower $f]
3072 while {[set j [string first $foundstring $str $i]] >= 0} {
3073 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3074 set i [expr {$j + $foundstrlen}]
3081 global findtype findloc findstring markedmatches commitinfo
3082 global numcommits displayorder linehtag linentag linedtag
3083 global mainfont canv canv2 canv3 selectedline
3084 global matchinglines foundstring foundstrlen matchstring
3090 set matchinglines {}
3091 if {$findtype == "IgnCase"} {
3092 set foundstring [string tolower $findstring]
3094 set foundstring $findstring
3096 set foundstrlen [string length $findstring]
3097 if {$foundstrlen == 0} return
3098 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3099 set matchstring "*$matchstring*"
3100 if {![info exists selectedline]} {
3103 set oldsel $selectedline
3106 set fldtypes {Headline Author Date Committer CDate Comments}
3108 foreach id $displayorder {
3109 set d $commitdata($id)
3111 if {$findtype == "Regexp"} {
3112 set doesmatch [regexp $foundstring $d]
3113 } elseif {$findtype == "IgnCase"} {
3114 set doesmatch [string match -nocase $matchstring $d]
3116 set doesmatch [string match $matchstring $d]
3118 if {!$doesmatch} continue
3119 if {![info exists commitinfo($id)]} {
3122 set info $commitinfo($id)
3124 foreach f $info ty $fldtypes {
3125 if {$findloc != "All fields" && $findloc != $ty} {
3128 set matches [findmatches $f]
3129 if {$matches == {}} continue
3131 if {$ty == "Headline"} {
3133 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3134 } elseif {$ty == "Author"} {
3136 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3137 } elseif {$ty == "Date"} {
3139 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3143 lappend matchinglines $l
3144 if {!$didsel && $l > $oldsel} {
3150 if {$matchinglines == {}} {
3152 } elseif {!$didsel} {
3153 findselectline [lindex $matchinglines 0]
3157 proc findselectline {l} {
3158 global findloc commentend ctext
3160 if {$findloc == "All fields" || $findloc == "Comments"} {
3161 # highlight the matches in the comments
3162 set f [$ctext get 1.0 $commentend]
3163 set matches [findmatches $f]
3164 foreach match $matches {
3165 set start [lindex $match 0]
3166 set end [expr {[lindex $match 1] + 1}]
3167 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3172 proc findnext {restart} {
3173 global matchinglines selectedline
3174 if {![info exists matchinglines]} {
3180 if {![info exists selectedline]} return
3181 foreach l $matchinglines {
3182 if {$l > $selectedline} {
3191 global matchinglines selectedline
3192 if {![info exists matchinglines]} {
3196 if {![info exists selectedline]} return
3198 foreach l $matchinglines {
3199 if {$l >= $selectedline} break
3203 findselectline $prev
3209 proc stopfindproc {{done 0}} {
3210 global findprocpid findprocfile findids
3211 global ctext findoldcursor phase maincursor textcursor
3212 global findinprogress
3214 catch {unset findids}
3215 if {[info exists findprocpid]} {
3217 catch {exec kill $findprocpid}
3219 catch {close $findprocfile}
3222 catch {unset findinprogress}
3226 # mark a commit as matching by putting a yellow background
3227 # behind the headline
3228 proc markheadline {l id} {
3229 global canv mainfont linehtag
3232 set bbox [$canv bbox $linehtag($l)]
3233 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3237 # mark the bits of a headline, author or date that match a find string
3238 proc markmatches {canv l str tag matches font} {
3239 set bbox [$canv bbox $tag]
3240 set x0 [lindex $bbox 0]
3241 set y0 [lindex $bbox 1]
3242 set y1 [lindex $bbox 3]
3243 foreach match $matches {
3244 set start [lindex $match 0]
3245 set end [lindex $match 1]
3246 if {$start > $end} continue
3247 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3248 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3249 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3250 [expr {$x0+$xlen+2}] $y1 \
3251 -outline {} -tags matches -fill yellow]
3256 proc unmarkmatches {} {
3257 global matchinglines findids
3258 allcanvs delete matches
3259 catch {unset matchinglines}
3260 catch {unset findids}
3263 proc selcanvline {w x y} {
3264 global canv canvy0 ctext linespc
3266 set ymax [lindex [$canv cget -scrollregion] 3]
3267 if {$ymax == {}} return
3268 set yfrac [lindex [$canv yview] 0]
3269 set y [expr {$y + $yfrac * $ymax}]
3270 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3275 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3281 proc commit_descriptor {p} {
3283 if {![info exists commitinfo($p)]} {
3287 if {[llength $commitinfo($p)] > 1} {
3288 set l [lindex $commitinfo($p) 0]
3293 # append some text to the ctext widget, and make any SHA1 ID
3294 # that we know about be a clickable link.
3295 proc appendwithlinks {text} {
3296 global ctext commitrow linknum curview
3298 set start [$ctext index "end - 1c"]
3299 $ctext insert end $text
3300 $ctext insert end "\n"
3301 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3305 set linkid [string range $text $s $e]
3306 if {![info exists commitrow($curview,$linkid)]} continue
3308 $ctext tag add link "$start + $s c" "$start + $e c"
3309 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3310 $ctext tag bind link$linknum <1> \
3311 [list selectline $commitrow($curview,$linkid) 1]
3314 $ctext tag conf link -foreground blue -underline 1
3315 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3316 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3319 proc viewnextline {dir} {
3323 set ymax [lindex [$canv cget -scrollregion] 3]
3324 set wnow [$canv yview]
3325 set wtop [expr {[lindex $wnow 0] * $ymax}]
3326 set newtop [expr {$wtop + $dir * $linespc}]
3329 } elseif {$newtop > $ymax} {
3332 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3335 proc selectline {l isnew} {
3336 global canv canv2 canv3 ctext commitinfo selectedline
3337 global displayorder linehtag linentag linedtag
3338 global canvy0 linespc parentlist childlist
3339 global currentid sha1entry
3340 global commentend idtags linknum
3341 global mergemax numcommits pending_select
3344 catch {unset pending_select}
3347 if {$l < 0 || $l >= $numcommits} return
3348 set y [expr {$canvy0 + $l * $linespc}]
3349 set ymax [lindex [$canv cget -scrollregion] 3]
3350 set ytop [expr {$y - $linespc - 1}]
3351 set ybot [expr {$y + $linespc + 1}]
3352 set wnow [$canv yview]
3353 set wtop [expr {[lindex $wnow 0] * $ymax}]
3354 set wbot [expr {[lindex $wnow 1] * $ymax}]
3355 set wh [expr {$wbot - $wtop}]
3357 if {$ytop < $wtop} {
3358 if {$ybot < $wtop} {
3359 set newtop [expr {$y - $wh / 2.0}]
3362 if {$newtop > $wtop - $linespc} {
3363 set newtop [expr {$wtop - $linespc}]
3366 } elseif {$ybot > $wbot} {
3367 if {$ytop > $wbot} {
3368 set newtop [expr {$y - $wh / 2.0}]
3370 set newtop [expr {$ybot - $wh}]
3371 if {$newtop < $wtop + $linespc} {
3372 set newtop [expr {$wtop + $linespc}]
3376 if {$newtop != $wtop} {
3380 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3384 if {![info exists linehtag($l)]} return
3386 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3387 -tags secsel -fill [$canv cget -selectbackground]]
3389 $canv2 delete secsel
3390 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3391 -tags secsel -fill [$canv2 cget -selectbackground]]
3393 $canv3 delete secsel
3394 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3395 -tags secsel -fill [$canv3 cget -selectbackground]]
3399 addtohistory [list selectline $l 0]
3404 set id [lindex $displayorder $l]
3406 $sha1entry delete 0 end
3407 $sha1entry insert 0 $id
3408 $sha1entry selection from 0
3409 $sha1entry selection to end
3411 $ctext conf -state normal
3414 set info $commitinfo($id)
3415 set date [formatdate [lindex $info 2]]
3416 $ctext insert end "Author: [lindex $info 1] $date\n"
3417 set date [formatdate [lindex $info 4]]
3418 $ctext insert end "Committer: [lindex $info 3] $date\n"
3419 if {[info exists idtags($id)]} {
3420 $ctext insert end "Tags:"
3421 foreach tag $idtags($id) {
3422 $ctext insert end " $tag"
3424 $ctext insert end "\n"
3428 set olds [lindex $parentlist $l]
3429 if {[llength $olds] > 1} {
3432 if {$np >= $mergemax} {
3437 $ctext insert end "Parent: " $tag
3438 appendwithlinks [commit_descriptor $p]
3443 append comment "Parent: [commit_descriptor $p]\n"
3447 foreach c [lindex $childlist $l] {
3448 append comment "Child: [commit_descriptor $c]\n"
3451 append comment [lindex $info 5]
3453 # make anything that looks like a SHA1 ID be a clickable link
3454 appendwithlinks $comment
3456 $ctext tag delete Comments
3457 $ctext tag remove found 1.0 end
3458 $ctext conf -state disabled
3459 set commentend [$ctext index "end - 1c"]
3461 init_flist "Comments"
3462 if {$cmitmode eq "tree"} {
3464 } elseif {[llength $olds] <= 1} {
3471 proc selfirstline {} {
3476 proc sellastline {} {
3479 set l [expr {$numcommits - 1}]
3483 proc selnextline {dir} {
3485 if {![info exists selectedline]} return
3486 set l [expr {$selectedline + $dir}]
3491 proc selnextpage {dir} {
3492 global canv linespc selectedline numcommits
3494 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3498 allcanvs yview scroll [expr {$dir * $lpp}] units
3500 if {![info exists selectedline]} return
3501 set l [expr {$selectedline + $dir * $lpp}]
3504 } elseif {$l >= $numcommits} {
3505 set l [expr $numcommits - 1]
3511 proc unselectline {} {
3512 global selectedline currentid
3514 catch {unset selectedline}
3515 catch {unset currentid}
3516 allcanvs delete secsel
3519 proc reselectline {} {
3522 if {[info exists selectedline]} {
3523 selectline $selectedline 0
3527 proc addtohistory {cmd} {
3528 global history historyindex curview
3530 set elt [list $curview $cmd]
3531 if {$historyindex > 0
3532 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3536 if {$historyindex < [llength $history]} {
3537 set history [lreplace $history $historyindex end $elt]
3539 lappend history $elt
3542 if {$historyindex > 1} {
3543 .ctop.top.bar.leftbut conf -state normal
3545 .ctop.top.bar.leftbut conf -state disabled
3547 .ctop.top.bar.rightbut conf -state disabled
3553 set view [lindex $elt 0]
3554 set cmd [lindex $elt 1]
3555 if {$curview != $view} {
3562 global history historyindex
3564 if {$historyindex > 1} {
3565 incr historyindex -1
3566 godo [lindex $history [expr {$historyindex - 1}]]
3567 .ctop.top.bar.rightbut conf -state normal
3569 if {$historyindex <= 1} {
3570 .ctop.top.bar.leftbut conf -state disabled
3575 global history historyindex
3577 if {$historyindex < [llength $history]} {
3578 set cmd [lindex $history $historyindex]
3581 .ctop.top.bar.leftbut conf -state normal
3583 if {$historyindex >= [llength $history]} {
3584 .ctop.top.bar.rightbut conf -state disabled
3589 global treefilelist treeidlist diffids diffmergeid treepending
3592 catch {unset diffmergeid}
3593 if {![info exists treefilelist($id)]} {
3594 if {![info exists treepending]} {
3595 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3599 set treefilelist($id) {}
3600 set treeidlist($id) {}
3601 fconfigure $gtf -blocking 0
3602 fileevent $gtf readable [list gettreeline $gtf $id]
3609 proc gettreeline {gtf id} {
3610 global treefilelist treeidlist treepending cmitmode diffids
3612 while {[gets $gtf line] >= 0} {
3613 if {[lindex $line 1] ne "blob"} continue
3614 set sha1 [lindex $line 2]
3615 set fname [lindex $line 3]
3616 lappend treefilelist($id) $fname
3617 lappend treeidlist($id) $sha1
3619 if {![eof $gtf]} return
3622 if {$cmitmode ne "tree"} {
3623 if {![info exists diffmergeid]} {
3624 gettreediffs $diffids
3626 } elseif {$id ne $diffids} {
3634 global treefilelist treeidlist diffids
3635 global ctext commentend
3637 set i [lsearch -exact $treefilelist($diffids) $f]
3639 puts "oops, $f not in list for id $diffids"
3642 set blob [lindex $treeidlist($diffids) $i]
3643 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3644 puts "oops, error reading blob $blob: $err"
3647 fconfigure $bf -blocking 0
3648 fileevent $bf readable [list getblobline $bf $diffids]
3649 $ctext config -state normal
3650 clear_ctext $commentend
3651 $ctext insert end "\n"
3652 $ctext insert end "$f\n" filesep
3653 $ctext config -state disabled
3654 $ctext yview $commentend
3657 proc getblobline {bf id} {
3658 global diffids cmitmode ctext
3660 if {$id ne $diffids || $cmitmode ne "tree"} {
3664 $ctext config -state normal
3665 while {[gets $bf line] >= 0} {
3666 $ctext insert end "$line\n"
3669 # delete last newline
3670 $ctext delete "end - 2c" "end - 1c"
3673 $ctext config -state disabled
3676 proc mergediff {id l} {
3677 global diffmergeid diffopts mdifffd
3683 # this doesn't seem to actually affect anything...
3684 set env(GIT_DIFF_OPTS) $diffopts
3685 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3686 if {[catch {set mdf [open $cmd r]} err]} {
3687 error_popup "Error getting merge diffs: $err"
3690 fconfigure $mdf -blocking 0
3691 set mdifffd($id) $mdf
3692 set np [llength [lindex $parentlist $l]]
3693 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3694 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3697 proc getmergediffline {mdf id np} {
3698 global diffmergeid ctext cflist nextupdate mergemax
3699 global difffilestart mdifffd
3701 set n [gets $mdf line]
3708 if {![info exists diffmergeid] || $id != $diffmergeid
3709 || $mdf != $mdifffd($id)} {
3712 $ctext conf -state normal
3713 if {[regexp {^diff --cc (.*)} $line match fname]} {
3714 # start of a new file
3715 $ctext insert end "\n"
3716 set here [$ctext index "end - 1c"]
3717 lappend difffilestart $here
3718 add_flist [list $fname]
3719 set l [expr {(78 - [string length $fname]) / 2}]
3720 set pad [string range "----------------------------------------" 1 $l]
3721 $ctext insert end "$pad $fname $pad\n" filesep
3722 } elseif {[regexp {^@@} $line]} {
3723 $ctext insert end "$line\n" hunksep
3724 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3727 # parse the prefix - one ' ', '-' or '+' for each parent
3732 for {set j 0} {$j < $np} {incr j} {
3733 set c [string range $line $j $j]
3736 } elseif {$c == "-"} {
3738 } elseif {$c == "+"} {
3747 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3748 # line doesn't appear in result, parents in $minuses have the line
3749 set num [lindex $minuses 0]
3750 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3751 # line appears in result, parents in $pluses don't have the line
3752 lappend tags mresult
3753 set num [lindex $spaces 0]
3756 if {$num >= $mergemax} {
3761 $ctext insert end "$line\n" $tags
3763 $ctext conf -state disabled
3764 if {[clock clicks -milliseconds] >= $nextupdate} {
3766 fileevent $mdf readable {}
3768 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3772 proc startdiff {ids} {
3773 global treediffs diffids treepending diffmergeid
3776 catch {unset diffmergeid}
3777 if {![info exists treediffs($ids)]} {
3778 if {![info exists treepending]} {
3786 proc addtocflist {ids} {
3787 global treediffs cflist
3788 add_flist $treediffs($ids)
3792 proc gettreediffs {ids} {
3793 global treediff treepending
3794 set treepending $ids
3797 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3799 fconfigure $gdtf -blocking 0
3800 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3803 proc gettreediffline {gdtf ids} {
3804 global treediff treediffs treepending diffids diffmergeid
3807 set n [gets $gdtf line]
3809 if {![eof $gdtf]} return
3811 set treediffs($ids) $treediff
3813 if {$cmitmode eq "tree"} {
3815 } elseif {$ids != $diffids} {
3816 if {![info exists diffmergeid]} {
3817 gettreediffs $diffids
3824 set file [lindex $line 5]
3825 lappend treediff $file
3828 proc getblobdiffs {ids} {
3829 global diffopts blobdifffd diffids env curdifftag curtagstart
3830 global nextupdate diffinhdr treediffs
3832 set env(GIT_DIFF_OPTS) $diffopts
3833 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3834 if {[catch {set bdf [open $cmd r]} err]} {
3835 puts "error getting diffs: $err"
3839 fconfigure $bdf -blocking 0
3840 set blobdifffd($ids) $bdf
3841 set curdifftag Comments
3843 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3844 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3847 proc setinlist {var i val} {
3850 while {[llength [set $var]] < $i} {
3853 if {[llength [set $var]] == $i} {
3860 proc getblobdiffline {bdf ids} {
3861 global diffids blobdifffd ctext curdifftag curtagstart
3862 global diffnexthead diffnextnote difffilestart
3863 global nextupdate diffinhdr treediffs
3865 set n [gets $bdf line]
3869 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
3870 $ctext tag add $curdifftag $curtagstart end
3875 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
3878 $ctext conf -state normal
3879 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
3880 # start of a new file
3881 $ctext insert end "\n"
3882 $ctext tag add $curdifftag $curtagstart end
3883 set here [$ctext index "end - 1c"]
3884 set curtagstart $here
3886 set i [lsearch -exact $treediffs($ids) $fname]
3888 setinlist difffilestart $i $here
3890 if {$newname ne $fname} {
3891 set i [lsearch -exact $treediffs($ids) $newname]
3893 setinlist difffilestart $i $here
3896 set curdifftag "f:$fname"
3897 $ctext tag delete $curdifftag
3898 set l [expr {(78 - [string length $header]) / 2}]
3899 set pad [string range "----------------------------------------" 1 $l]
3900 $ctext insert end "$pad $header $pad\n" filesep
3902 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
3904 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
3906 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
3907 $line match f1l f1c f2l f2c rest]} {
3908 $ctext insert end "$line\n" hunksep
3911 set x [string range $line 0 0]
3912 if {$x == "-" || $x == "+"} {
3913 set tag [expr {$x == "+"}]
3914 $ctext insert end "$line\n" d$tag
3915 } elseif {$x == " "} {
3916 $ctext insert end "$line\n"
3917 } elseif {$diffinhdr || $x == "\\"} {
3918 # e.g. "\ No newline at end of file"
3919 $ctext insert end "$line\n" filesep
3921 # Something else we don't recognize
3922 if {$curdifftag != "Comments"} {
3923 $ctext insert end "\n"
3924 $ctext tag add $curdifftag $curtagstart end
3925 set curtagstart [$ctext index "end - 1c"]
3926 set curdifftag Comments
3928 $ctext insert end "$line\n" filesep
3931 $ctext conf -state disabled
3932 if {[clock clicks -milliseconds] >= $nextupdate} {
3934 fileevent $bdf readable {}
3936 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
3941 global difffilestart ctext
3942 set here [$ctext index @0,0]
3943 foreach loc $difffilestart {
3944 if {[$ctext compare $loc > $here]} {
3950 proc clear_ctext {{first 1.0}} {
3951 global ctext smarktop smarkbot
3953 set l [lindex [split $first .] 0]
3954 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
3957 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
3960 $ctext delete $first end
3963 proc incrsearch {name ix op} {
3964 global ctext searchstring searchdirn
3966 $ctext tag remove found 1.0 end
3967 if {[catch {$ctext index anchor}]} {
3968 # no anchor set, use start of selection, or of visible area
3969 set sel [$ctext tag ranges sel]
3971 $ctext mark set anchor [lindex $sel 0]
3972 } elseif {$searchdirn eq "-forwards"} {
3973 $ctext mark set anchor @0,0
3975 $ctext mark set anchor @0,[winfo height $ctext]
3978 if {$searchstring ne {}} {
3979 set here [$ctext search $searchdirn -- $searchstring anchor]
3988 global sstring ctext searchstring searchdirn
3991 $sstring icursor end
3992 set searchdirn -forwards
3993 if {$searchstring ne {}} {
3994 set sel [$ctext tag ranges sel]
3996 set start "[lindex $sel 0] + 1c"
3997 } elseif {[catch {set start [$ctext index anchor]}]} {
4000 set match [$ctext search -count mlen -- $searchstring $start]
4001 $ctext tag remove sel 1.0 end
4007 set mend "$match + $mlen c"
4008 $ctext tag add sel $match $mend
4009 $ctext mark unset anchor
4013 proc dosearchback {} {
4014 global sstring ctext searchstring searchdirn
4017 $sstring icursor end
4018 set searchdirn -backwards
4019 if {$searchstring ne {}} {
4020 set sel [$ctext tag ranges sel]
4022 set start [lindex $sel 0]
4023 } elseif {[catch {set start [$ctext index anchor]}]} {
4024 set start @0,[winfo height $ctext]
4026 set match [$ctext search -backwards -count ml -- $searchstring $start]
4027 $ctext tag remove sel 1.0 end
4033 set mend "$match + $ml c"
4034 $ctext tag add sel $match $mend
4035 $ctext mark unset anchor
4039 proc searchmark {first last} {
4040 global ctext searchstring
4044 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4045 if {$match eq {}} break
4046 set mend "$match + $mlen c"
4047 $ctext tag add found $match $mend
4051 proc searchmarkvisible {doall} {
4052 global ctext smarktop smarkbot
4054 set topline [lindex [split [$ctext index @0,0] .] 0]
4055 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4056 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4057 # no overlap with previous
4058 searchmark $topline $botline
4059 set smarktop $topline
4060 set smarkbot $botline
4062 if {$topline < $smarktop} {
4063 searchmark $topline [expr {$smarktop-1}]
4064 set smarktop $topline
4066 if {$botline > $smarkbot} {
4067 searchmark [expr {$smarkbot+1}] $botline
4068 set smarkbot $botline
4073 proc scrolltext {f0 f1} {
4076 .ctop.cdet.left.sb set $f0 $f1
4077 if {$searchstring ne {}} {
4083 global linespc charspc canvx0 canvy0 mainfont
4084 global xspc1 xspc2 lthickness
4086 set linespc [font metrics $mainfont -linespace]
4087 set charspc [font measure $mainfont "m"]
4088 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4089 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4090 set lthickness [expr {int($linespc / 9) + 1}]
4091 set xspc1(0) $linespc
4099 set ymax [lindex [$canv cget -scrollregion] 3]
4100 if {$ymax eq {} || $ymax == 0} return
4101 set span [$canv yview]
4104 allcanvs yview moveto [lindex $span 0]
4106 if {[info exists selectedline]} {
4107 selectline $selectedline 0
4111 proc incrfont {inc} {
4112 global mainfont textfont ctext canv phase
4113 global stopped entries
4115 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4116 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4118 $ctext conf -font $textfont
4119 $ctext tag conf filesep -font [concat $textfont bold]
4120 foreach e $entries {
4121 $e conf -font $mainfont
4123 if {$phase eq "getcommits"} {
4124 $canv itemconf textitems -font $mainfont
4130 global sha1entry sha1string
4131 if {[string length $sha1string] == 40} {
4132 $sha1entry delete 0 end
4136 proc sha1change {n1 n2 op} {
4137 global sha1string currentid sha1but
4138 if {$sha1string == {}
4139 || ([info exists currentid] && $sha1string == $currentid)} {
4144 if {[$sha1but cget -state] == $state} return
4145 if {$state == "normal"} {
4146 $sha1but conf -state normal -relief raised -text "Goto: "
4148 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4152 proc gotocommit {} {
4153 global sha1string currentid commitrow tagids headids
4154 global displayorder numcommits curview
4156 if {$sha1string == {}
4157 || ([info exists currentid] && $sha1string == $currentid)} return
4158 if {[info exists tagids($sha1string)]} {
4159 set id $tagids($sha1string)
4160 } elseif {[info exists headids($sha1string)]} {
4161 set id $headids($sha1string)
4163 set id [string tolower $sha1string]
4164 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4166 foreach i $displayorder {
4167 if {[string match $id* $i]} {
4171 if {$matches ne {}} {
4172 if {[llength $matches] > 1} {
4173 error_popup "Short SHA1 id $id is ambiguous"
4176 set id [lindex $matches 0]
4180 if {[info exists commitrow($curview,$id)]} {
4181 selectline $commitrow($curview,$id) 1
4184 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4189 error_popup "$type $sha1string is not known"
4192 proc lineenter {x y id} {
4193 global hoverx hovery hoverid hovertimer
4194 global commitinfo canv
4196 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4200 if {[info exists hovertimer]} {
4201 after cancel $hovertimer
4203 set hovertimer [after 500 linehover]
4207 proc linemotion {x y id} {
4208 global hoverx hovery hoverid hovertimer
4210 if {[info exists hoverid] && $id == $hoverid} {
4213 if {[info exists hovertimer]} {
4214 after cancel $hovertimer
4216 set hovertimer [after 500 linehover]
4220 proc lineleave {id} {
4221 global hoverid hovertimer canv
4223 if {[info exists hoverid] && $id == $hoverid} {
4225 if {[info exists hovertimer]} {
4226 after cancel $hovertimer
4234 global hoverx hovery hoverid hovertimer
4235 global canv linespc lthickness
4236 global commitinfo mainfont
4238 set text [lindex $commitinfo($hoverid) 0]
4239 set ymax [lindex [$canv cget -scrollregion] 3]
4240 if {$ymax == {}} return
4241 set yfrac [lindex [$canv yview] 0]
4242 set x [expr {$hoverx + 2 * $linespc}]
4243 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4244 set x0 [expr {$x - 2 * $lthickness}]
4245 set y0 [expr {$y - 2 * $lthickness}]
4246 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4247 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4248 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4249 -fill \#ffff80 -outline black -width 1 -tags hover]
4251 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4255 proc clickisonarrow {id y} {
4258 set ranges [rowranges $id]
4259 set thresh [expr {2 * $lthickness + 6}]
4260 set n [expr {[llength $ranges] - 1}]
4261 for {set i 1} {$i < $n} {incr i} {
4262 set row [lindex $ranges $i]
4263 if {abs([yc $row] - $y) < $thresh} {
4270 proc arrowjump {id n y} {
4273 # 1 <-> 2, 3 <-> 4, etc...
4274 set n [expr {(($n - 1) ^ 1) + 1}]
4275 set row [lindex [rowranges $id] $n]
4277 set ymax [lindex [$canv cget -scrollregion] 3]
4278 if {$ymax eq {} || $ymax <= 0} return
4279 set view [$canv yview]
4280 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4281 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4285 allcanvs yview moveto $yfrac
4288 proc lineclick {x y id isnew} {
4289 global ctext commitinfo children canv thickerline curview
4291 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4296 # draw this line thicker than normal
4300 set ymax [lindex [$canv cget -scrollregion] 3]
4301 if {$ymax eq {}} return
4302 set yfrac [lindex [$canv yview] 0]
4303 set y [expr {$y + $yfrac * $ymax}]
4305 set dirn [clickisonarrow $id $y]
4307 arrowjump $id $dirn $y
4312 addtohistory [list lineclick $x $y $id 0]
4314 # fill the details pane with info about this line
4315 $ctext conf -state normal
4317 $ctext tag conf link -foreground blue -underline 1
4318 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4319 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4320 $ctext insert end "Parent:\t"
4321 $ctext insert end $id [list link link0]
4322 $ctext tag bind link0 <1> [list selbyid $id]
4323 set info $commitinfo($id)
4324 $ctext insert end "\n\t[lindex $info 0]\n"
4325 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4326 set date [formatdate [lindex $info 2]]
4327 $ctext insert end "\tDate:\t$date\n"
4328 set kids $children($curview,$id)
4330 $ctext insert end "\nChildren:"
4332 foreach child $kids {
4334 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4335 set info $commitinfo($child)
4336 $ctext insert end "\n\t"
4337 $ctext insert end $child [list link link$i]
4338 $ctext tag bind link$i <1> [list selbyid $child]
4339 $ctext insert end "\n\t[lindex $info 0]"
4340 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4341 set date [formatdate [lindex $info 2]]
4342 $ctext insert end "\n\tDate:\t$date\n"
4345 $ctext conf -state disabled
4349 proc normalline {} {
4351 if {[info exists thickerline]} {
4359 global commitrow curview
4360 if {[info exists commitrow($curview,$id)]} {
4361 selectline $commitrow($curview,$id) 1
4367 if {![info exists startmstime]} {
4368 set startmstime [clock clicks -milliseconds]
4370 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4373 proc rowmenu {x y id} {
4374 global rowctxmenu commitrow selectedline rowmenuid curview
4376 if {![info exists selectedline]
4377 || $commitrow($curview,$id) eq $selectedline} {
4382 $rowctxmenu entryconfigure 0 -state $state
4383 $rowctxmenu entryconfigure 1 -state $state
4384 $rowctxmenu entryconfigure 2 -state $state
4386 tk_popup $rowctxmenu $x $y
4389 proc diffvssel {dirn} {
4390 global rowmenuid selectedline displayorder
4392 if {![info exists selectedline]} return
4394 set oldid [lindex $displayorder $selectedline]
4395 set newid $rowmenuid
4397 set oldid $rowmenuid
4398 set newid [lindex $displayorder $selectedline]
4400 addtohistory [list doseldiff $oldid $newid]
4401 doseldiff $oldid $newid
4404 proc doseldiff {oldid newid} {
4408 $ctext conf -state normal
4411 $ctext insert end "From "
4412 $ctext tag conf link -foreground blue -underline 1
4413 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4414 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4415 $ctext tag bind link0 <1> [list selbyid $oldid]
4416 $ctext insert end $oldid [list link link0]
4417 $ctext insert end "\n "
4418 $ctext insert end [lindex $commitinfo($oldid) 0]
4419 $ctext insert end "\n\nTo "
4420 $ctext tag bind link1 <1> [list selbyid $newid]
4421 $ctext insert end $newid [list link link1]
4422 $ctext insert end "\n "
4423 $ctext insert end [lindex $commitinfo($newid) 0]
4424 $ctext insert end "\n"
4425 $ctext conf -state disabled
4426 $ctext tag delete Comments
4427 $ctext tag remove found 1.0 end
4428 startdiff [list $oldid $newid]
4432 global rowmenuid currentid commitinfo patchtop patchnum
4434 if {![info exists currentid]} return
4435 set oldid $currentid
4436 set oldhead [lindex $commitinfo($oldid) 0]
4437 set newid $rowmenuid
4438 set newhead [lindex $commitinfo($newid) 0]
4441 catch {destroy $top}
4443 label $top.title -text "Generate patch"
4444 grid $top.title - -pady 10
4445 label $top.from -text "From:"
4446 entry $top.fromsha1 -width 40 -relief flat
4447 $top.fromsha1 insert 0 $oldid
4448 $top.fromsha1 conf -state readonly
4449 grid $top.from $top.fromsha1 -sticky w
4450 entry $top.fromhead -width 60 -relief flat
4451 $top.fromhead insert 0 $oldhead
4452 $top.fromhead conf -state readonly
4453 grid x $top.fromhead -sticky w
4454 label $top.to -text "To:"
4455 entry $top.tosha1 -width 40 -relief flat
4456 $top.tosha1 insert 0 $newid
4457 $top.tosha1 conf -state readonly
4458 grid $top.to $top.tosha1 -sticky w
4459 entry $top.tohead -width 60 -relief flat
4460 $top.tohead insert 0 $newhead
4461 $top.tohead conf -state readonly
4462 grid x $top.tohead -sticky w
4463 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4464 grid $top.rev x -pady 10
4465 label $top.flab -text "Output file:"
4466 entry $top.fname -width 60
4467 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4469 grid $top.flab $top.fname -sticky w
4471 button $top.buts.gen -text "Generate" -command mkpatchgo
4472 button $top.buts.can -text "Cancel" -command mkpatchcan
4473 grid $top.buts.gen $top.buts.can
4474 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4475 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4476 grid $top.buts - -pady 10 -sticky ew
4480 proc mkpatchrev {} {
4483 set oldid [$patchtop.fromsha1 get]
4484 set oldhead [$patchtop.fromhead get]
4485 set newid [$patchtop.tosha1 get]
4486 set newhead [$patchtop.tohead get]
4487 foreach e [list fromsha1 fromhead tosha1 tohead] \
4488 v [list $newid $newhead $oldid $oldhead] {
4489 $patchtop.$e conf -state normal
4490 $patchtop.$e delete 0 end
4491 $patchtop.$e insert 0 $v
4492 $patchtop.$e conf -state readonly
4499 set oldid [$patchtop.fromsha1 get]
4500 set newid [$patchtop.tosha1 get]
4501 set fname [$patchtop.fname get]
4502 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4503 error_popup "Error creating patch: $err"
4505 catch {destroy $patchtop}
4509 proc mkpatchcan {} {
4512 catch {destroy $patchtop}
4517 global rowmenuid mktagtop commitinfo
4521 catch {destroy $top}
4523 label $top.title -text "Create tag"
4524 grid $top.title - -pady 10
4525 label $top.id -text "ID:"
4526 entry $top.sha1 -width 40 -relief flat
4527 $top.sha1 insert 0 $rowmenuid
4528 $top.sha1 conf -state readonly
4529 grid $top.id $top.sha1 -sticky w
4530 entry $top.head -width 60 -relief flat
4531 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4532 $top.head conf -state readonly
4533 grid x $top.head -sticky w
4534 label $top.tlab -text "Tag name:"
4535 entry $top.tag -width 60
4536 grid $top.tlab $top.tag -sticky w
4538 button $top.buts.gen -text "Create" -command mktaggo
4539 button $top.buts.can -text "Cancel" -command mktagcan
4540 grid $top.buts.gen $top.buts.can
4541 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4542 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4543 grid $top.buts - -pady 10 -sticky ew
4548 global mktagtop env tagids idtags
4550 set id [$mktagtop.sha1 get]
4551 set tag [$mktagtop.tag get]
4553 error_popup "No tag name specified"
4556 if {[info exists tagids($tag)]} {
4557 error_popup "Tag \"$tag\" already exists"
4562 set fname [file join $dir "refs/tags" $tag]
4563 set f [open $fname w]
4567 error_popup "Error creating tag: $err"
4571 set tagids($tag) $id
4572 lappend idtags($id) $tag
4576 proc redrawtags {id} {
4577 global canv linehtag commitrow idpos selectedline curview
4579 if {![info exists commitrow($curview,$id)]} return
4580 drawcmitrow $commitrow($curview,$id)
4581 $canv delete tag.$id
4582 set xt [eval drawtags $id $idpos($id)]
4583 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4584 if {[info exists selectedline]
4585 && $selectedline == $commitrow($curview,$id)} {
4586 selectline $selectedline 0
4593 catch {destroy $mktagtop}
4602 proc writecommit {} {
4603 global rowmenuid wrcomtop commitinfo wrcomcmd
4605 set top .writecommit
4607 catch {destroy $top}
4609 label $top.title -text "Write commit to file"
4610 grid $top.title - -pady 10
4611 label $top.id -text "ID:"
4612 entry $top.sha1 -width 40 -relief flat
4613 $top.sha1 insert 0 $rowmenuid
4614 $top.sha1 conf -state readonly
4615 grid $top.id $top.sha1 -sticky w
4616 entry $top.head -width 60 -relief flat
4617 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4618 $top.head conf -state readonly
4619 grid x $top.head -sticky w
4620 label $top.clab -text "Command:"
4621 entry $top.cmd -width 60 -textvariable wrcomcmd
4622 grid $top.clab $top.cmd -sticky w -pady 10
4623 label $top.flab -text "Output file:"
4624 entry $top.fname -width 60
4625 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4626 grid $top.flab $top.fname -sticky w
4628 button $top.buts.gen -text "Write" -command wrcomgo
4629 button $top.buts.can -text "Cancel" -command wrcomcan
4630 grid $top.buts.gen $top.buts.can
4631 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4632 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4633 grid $top.buts - -pady 10 -sticky ew
4640 set id [$wrcomtop.sha1 get]
4641 set cmd "echo $id | [$wrcomtop.cmd get]"
4642 set fname [$wrcomtop.fname get]
4643 if {[catch {exec sh -c $cmd >$fname &} err]} {
4644 error_popup "Error writing commit: $err"
4646 catch {destroy $wrcomtop}
4653 catch {destroy $wrcomtop}
4657 proc listrefs {id} {
4658 global idtags idheads idotherrefs
4661 if {[info exists idtags($id)]} {
4665 if {[info exists idheads($id)]} {
4669 if {[info exists idotherrefs($id)]} {
4670 set z $idotherrefs($id)
4672 return [list $x $y $z]
4675 proc rereadrefs {} {
4676 global idtags idheads idotherrefs
4678 set refids [concat [array names idtags] \
4679 [array names idheads] [array names idotherrefs]]
4680 foreach id $refids {
4681 if {![info exists ref($id)]} {
4682 set ref($id) [listrefs $id]
4686 set refids [lsort -unique [concat $refids [array names idtags] \
4687 [array names idheads] [array names idotherrefs]]]
4688 foreach id $refids {
4689 set v [listrefs $id]
4690 if {![info exists ref($id)] || $ref($id) != $v} {
4696 proc showtag {tag isnew} {
4697 global ctext tagcontents tagids linknum
4700 addtohistory [list showtag $tag 0]
4702 $ctext conf -state normal
4705 if {[info exists tagcontents($tag)]} {
4706 set text $tagcontents($tag)
4708 set text "Tag: $tag\nId: $tagids($tag)"
4710 appendwithlinks $text
4711 $ctext conf -state disabled
4722 global maxwidth maxgraphpct diffopts
4723 global oldprefs prefstop
4727 if {[winfo exists $top]} {
4731 foreach v {maxwidth maxgraphpct diffopts} {
4732 set oldprefs($v) [set $v]
4735 wm title $top "Gitk preferences"
4736 label $top.ldisp -text "Commit list display options"
4737 grid $top.ldisp - -sticky w -pady 10
4738 label $top.spacer -text " "
4739 label $top.maxwidthl -text "Maximum graph width (lines)" \
4741 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4742 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4743 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4745 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4746 grid x $top.maxpctl $top.maxpct -sticky w
4747 label $top.ddisp -text "Diff display options"
4748 grid $top.ddisp - -sticky w -pady 10
4749 label $top.diffoptl -text "Options for diff program" \
4751 entry $top.diffopt -width 20 -textvariable diffopts
4752 grid x $top.diffoptl $top.diffopt -sticky w
4754 button $top.buts.ok -text "OK" -command prefsok
4755 button $top.buts.can -text "Cancel" -command prefscan
4756 grid $top.buts.ok $top.buts.can
4757 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4758 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4759 grid $top.buts - - -pady 10 -sticky ew
4763 global maxwidth maxgraphpct diffopts
4764 global oldprefs prefstop
4766 foreach v {maxwidth maxgraphpct diffopts} {
4767 set $v $oldprefs($v)
4769 catch {destroy $prefstop}
4774 global maxwidth maxgraphpct
4775 global oldprefs prefstop
4777 catch {destroy $prefstop}
4779 if {$maxwidth != $oldprefs(maxwidth)
4780 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4785 proc formatdate {d} {
4786 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4789 # This list of encoding names and aliases is distilled from
4790 # http://www.iana.org/assignments/character-sets.
4791 # Not all of them are supported by Tcl.
4792 set encoding_aliases {
4793 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4794 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4795 { ISO-10646-UTF-1 csISO10646UTF1 }
4796 { ISO_646.basic:1983 ref csISO646basic1983 }
4797 { INVARIANT csINVARIANT }
4798 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4799 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4800 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4801 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4802 { NATS-DANO iso-ir-9-1 csNATSDANO }
4803 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4804 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4805 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4806 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4807 { ISO-2022-KR csISO2022KR }
4809 { ISO-2022-JP csISO2022JP }
4810 { ISO-2022-JP-2 csISO2022JP2 }
4811 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4813 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4814 { IT iso-ir-15 ISO646-IT csISO15Italian }
4815 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4816 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4817 { greek7-old iso-ir-18 csISO18Greek7Old }
4818 { latin-greek iso-ir-19 csISO19LatinGreek }
4819 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4820 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4821 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4822 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4823 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4824 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4825 { INIS iso-ir-49 csISO49INIS }
4826 { INIS-8 iso-ir-50 csISO50INIS8 }
4827 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4828 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4829 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4830 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4831 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4832 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4834 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4835 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4836 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4837 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4838 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4839 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4840 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4841 { greek7 iso-ir-88 csISO88Greek7 }
4842 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4843 { iso-ir-90 csISO90 }
4844 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4845 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4846 csISO92JISC62991984b }
4847 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4848 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4849 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4850 csISO95JIS62291984handadd }
4851 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4852 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4853 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4854 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4856 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4857 { T.61-7bit iso-ir-102 csISO102T617bit }
4858 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4859 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4860 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4861 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4862 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4863 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4864 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4865 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4866 arabic csISOLatinArabic }
4867 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4868 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4869 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4870 greek greek8 csISOLatinGreek }
4871 { T.101-G2 iso-ir-128 csISO128T101G2 }
4872 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4874 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4875 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4876 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4877 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4878 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4879 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4880 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4881 csISOLatinCyrillic }
4882 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4883 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4884 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4885 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4886 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4887 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4888 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4889 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4890 { ISO_10367-box iso-ir-155 csISO10367Box }
4891 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4892 { latin-lap lap iso-ir-158 csISO158Lap }
4893 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4894 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4897 { JIS_X0201 X0201 csHalfWidthKatakana }
4898 { KSC5636 ISO646-KR csKSC5636 }
4899 { ISO-10646-UCS-2 csUnicode }
4900 { ISO-10646-UCS-4 csUCS4 }
4901 { DEC-MCS dec csDECMCS }
4902 { hp-roman8 roman8 r8 csHPRoman8 }
4903 { macintosh mac csMacintosh }
4904 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4906 { IBM038 EBCDIC-INT cp038 csIBM038 }
4907 { IBM273 CP273 csIBM273 }
4908 { IBM274 EBCDIC-BE CP274 csIBM274 }
4909 { IBM275 EBCDIC-BR cp275 csIBM275 }
4910 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4911 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4912 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4913 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4914 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4915 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4916 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4917 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4918 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4919 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4920 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4921 { IBM437 cp437 437 csPC8CodePage437 }
4922 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4923 { IBM775 cp775 csPC775Baltic }
4924 { IBM850 cp850 850 csPC850Multilingual }
4925 { IBM851 cp851 851 csIBM851 }
4926 { IBM852 cp852 852 csPCp852 }
4927 { IBM855 cp855 855 csIBM855 }
4928 { IBM857 cp857 857 csIBM857 }
4929 { IBM860 cp860 860 csIBM860 }
4930 { IBM861 cp861 861 cp-is csIBM861 }
4931 { IBM862 cp862 862 csPC862LatinHebrew }
4932 { IBM863 cp863 863 csIBM863 }
4933 { IBM864 cp864 csIBM864 }
4934 { IBM865 cp865 865 csIBM865 }
4935 { IBM866 cp866 866 csIBM866 }
4936 { IBM868 CP868 cp-ar csIBM868 }
4937 { IBM869 cp869 869 cp-gr csIBM869 }
4938 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4939 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4940 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4941 { IBM891 cp891 csIBM891 }
4942 { IBM903 cp903 csIBM903 }
4943 { IBM904 cp904 904 csIBBM904 }
4944 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4945 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4946 { IBM1026 CP1026 csIBM1026 }
4947 { EBCDIC-AT-DE csIBMEBCDICATDE }
4948 { EBCDIC-AT-DE-A csEBCDICATDEA }
4949 { EBCDIC-CA-FR csEBCDICCAFR }
4950 { EBCDIC-DK-NO csEBCDICDKNO }
4951 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4952 { EBCDIC-FI-SE csEBCDICFISE }
4953 { EBCDIC-FI-SE-A csEBCDICFISEA }
4954 { EBCDIC-FR csEBCDICFR }
4955 { EBCDIC-IT csEBCDICIT }
4956 { EBCDIC-PT csEBCDICPT }
4957 { EBCDIC-ES csEBCDICES }
4958 { EBCDIC-ES-A csEBCDICESA }
4959 { EBCDIC-ES-S csEBCDICESS }
4960 { EBCDIC-UK csEBCDICUK }
4961 { EBCDIC-US csEBCDICUS }
4962 { UNKNOWN-8BIT csUnknown8BiT }
4963 { MNEMONIC csMnemonic }
4968 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
4969 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
4970 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
4971 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
4972 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
4973 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
4974 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
4975 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
4976 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
4977 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
4978 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
4979 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
4980 { IBM1047 IBM-1047 }
4981 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
4982 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
4983 { UNICODE-1-1 csUnicode11 }
4986 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
4987 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
4989 { ISO-8859-15 ISO_8859-15 Latin-9 }
4990 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
4991 { GBK CP936 MS936 windows-936 }
4992 { JIS_Encoding csJISEncoding }
4993 { Shift_JIS MS_Kanji csShiftJIS }
4994 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
4996 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
4997 { ISO-10646-UCS-Basic csUnicodeASCII }
4998 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
4999 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5000 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5001 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5002 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5003 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5004 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5005 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5006 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5007 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5008 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5009 { Ventura-US csVenturaUS }
5010 { Ventura-International csVenturaInternational }
5011 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5012 { PC8-Turkish csPC8Turkish }
5013 { IBM-Symbols csIBMSymbols }
5014 { IBM-Thai csIBMThai }
5015 { HP-Legal csHPLegal }
5016 { HP-Pi-font csHPPiFont }
5017 { HP-Math8 csHPMath8 }
5018 { Adobe-Symbol-Encoding csHPPSMath }
5019 { HP-DeskTop csHPDesktop }
5020 { Ventura-Math csVenturaMath }
5021 { Microsoft-Publishing csMicrosoftPublishing }
5022 { Windows-31J csWindows31J }
5027 proc tcl_encoding {enc} {
5028 global encoding_aliases
5029 set names [encoding names]
5030 set lcnames [string tolower $names]
5031 set enc [string tolower $enc]
5032 set i [lsearch -exact $lcnames $enc]
5034 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5035 if {[regsub {^iso[-_]} $enc iso encx]} {
5036 set i [lsearch -exact $lcnames $encx]
5040 foreach l $encoding_aliases {
5041 set ll [string tolower $l]
5042 if {[lsearch -exact $ll $enc] < 0} continue
5043 # look through the aliases for one that tcl knows about
5045 set i [lsearch -exact $lcnames $e]
5047 if {[regsub {^iso[-_]} $e iso ex]} {
5048 set i [lsearch -exact $lcnames $ex]
5057 return [lindex $names $i]
5064 set diffopts "-U 5 -p"
5065 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5069 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5071 if {$gitencoding == ""} {
5072 set gitencoding "utf-8"
5074 set tclencoding [tcl_encoding $gitencoding]
5075 if {$tclencoding == {}} {
5076 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5079 set mainfont {Helvetica 9}
5080 set textfont {Courier 9}
5081 set uifont {Helvetica 9 bold}
5082 set findmergefiles 0
5090 set cmitmode "patch"
5092 set colors {green red blue magenta darkgrey brown orange}
5094 catch {source ~/.gitk}
5096 font create optionfont -family sans-serif -size -12
5100 switch -regexp -- $arg {
5102 "^-d" { set datemode 1 }
5104 lappend revtreeargs $arg
5109 # check that we can find a .git directory somewhere...
5111 if {![file isdirectory $gitdir]} {
5112 show_error . "Cannot find the git directory \"$gitdir\"."
5116 set cmdline_files {}
5117 set i [lsearch -exact $revtreeargs "--"]
5119 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5120 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5121 } elseif {$revtreeargs ne {}} {
5123 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5124 set cmdline_files [split $f "\n"]
5125 set n [llength $cmdline_files]
5126 set revtreeargs [lrange $revtreeargs 0 end-$n]
5128 # unfortunately we get both stdout and stderr in $err,
5129 # so look for "fatal:".
5130 set i [string first "fatal:" $err]
5132 set err [string range [expr {$i + 6}] end]
5134 show_error . "Bad arguments to gitk:\n$err"
5143 set highlight_paths {}
5144 set searchdirn -forwards
5151 set selectedhlview None
5164 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5165 # create a view for the files/dirs specified on the command line
5169 set viewname(1) "Command line"
5170 set viewfiles(1) $cmdline_files
5171 set viewargs(1) $revtreeargs
5174 .bar.view entryconf 2 -state normal
5175 .bar.view entryconf 3 -state normal
5178 if {[info exists permviews]} {
5179 foreach v $permviews {
5182 set viewname($n) [lindex $v 0]
5183 set viewfiles($n) [lindex $v 1]
5184 set viewargs($n) [lindex $v 2]