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 highlight_names
389 .bar add cascade -label "File" -menu .bar.file
390 .bar configure -font $uifont
392 .bar.file add command -label "Update" -command updatecommits
393 .bar.file add command -label "Reread references" -command rereadrefs
394 .bar.file add command -label "Quit" -command doquit
395 .bar.file configure -font $uifont
397 .bar add cascade -label "Edit" -menu .bar.edit
398 .bar.edit add command -label "Preferences" -command doprefs
399 .bar.edit configure -font $uifont
401 menu .bar.view -font $uifont
402 .bar add cascade -label "View" -menu .bar.view
403 .bar.view add command -label "New view..." -command {newview 0}
404 .bar.view add command -label "Edit view..." -command editview \
406 .bar.view add command -label "Delete view" -command delview -state disabled
407 .bar.view add separator
408 .bar.view add radiobutton -label "All files" -command {showview 0} \
409 -variable selectedview -value 0
412 .bar add cascade -label "Help" -menu .bar.help
413 .bar.help add command -label "About gitk" -command about
414 .bar.help add command -label "Key bindings" -command keys
415 .bar.help configure -font $uifont
416 . configure -menu .bar
418 if {![info exists geometry(canv1)]} {
419 set geometry(canv1) [expr {45 * $charspc}]
420 set geometry(canv2) [expr {30 * $charspc}]
421 set geometry(canv3) [expr {15 * $charspc}]
422 set geometry(canvh) [expr {25 * $linespc + 4}]
423 set geometry(ctextw) 80
424 set geometry(ctexth) 30
425 set geometry(cflistw) 30
427 panedwindow .ctop -orient vertical
428 if {[info exists geometry(width)]} {
429 .ctop conf -width $geometry(width) -height $geometry(height)
430 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
431 set geometry(ctexth) [expr {($texth - 8) /
432 [font metrics $textfont -linespace]}]
437 pack .ctop.top.lbar -side bottom -fill x
438 pack .ctop.top.bar -side bottom -fill x
439 set cscroll .ctop.top.csb
440 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
441 pack $cscroll -side right -fill y
442 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
443 pack .ctop.top.clist -side top -fill both -expand 1
445 set canv .ctop.top.clist.canv
446 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
448 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
449 .ctop.top.clist add $canv
450 set canv2 .ctop.top.clist.canv2
451 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
452 -bg white -bd 0 -yscrollincr $linespc
453 .ctop.top.clist add $canv2
454 set canv3 .ctop.top.clist.canv3
455 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
456 -bg white -bd 0 -yscrollincr $linespc
457 .ctop.top.clist add $canv3
458 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
460 set sha1entry .ctop.top.bar.sha1
461 set entries $sha1entry
462 set sha1but .ctop.top.bar.sha1label
463 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
464 -command gotocommit -width 8 -font $uifont
465 $sha1but conf -disabledforeground [$sha1but cget -foreground]
466 pack .ctop.top.bar.sha1label -side left
467 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
468 trace add variable sha1string write sha1change
469 pack $sha1entry -side left -pady 2
471 image create bitmap bm-left -data {
472 #define left_width 16
473 #define left_height 16
474 static unsigned char left_bits[] = {
475 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
476 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
477 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
479 image create bitmap bm-right -data {
480 #define right_width 16
481 #define right_height 16
482 static unsigned char right_bits[] = {
483 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
484 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
485 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
487 button .ctop.top.bar.leftbut -image bm-left -command goback \
488 -state disabled -width 26
489 pack .ctop.top.bar.leftbut -side left -fill y
490 button .ctop.top.bar.rightbut -image bm-right -command goforw \
491 -state disabled -width 26
492 pack .ctop.top.bar.rightbut -side left -fill y
494 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
495 pack .ctop.top.bar.findbut -side left
497 set fstring .ctop.top.bar.findstring
498 lappend entries $fstring
499 entry $fstring -width 30 -font $textfont -textvariable findstring
500 pack $fstring -side left -expand 1 -fill x
502 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
503 findtype Exact IgnCase Regexp]
504 .ctop.top.bar.findtype configure -font $uifont
505 .ctop.top.bar.findtype.menu configure -font $uifont
506 set findloc "All fields"
507 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
508 Comments Author Committer Files Pickaxe
509 .ctop.top.bar.findloc configure -font $uifont
510 .ctop.top.bar.findloc.menu configure -font $uifont
512 pack .ctop.top.bar.findloc -side right
513 pack .ctop.top.bar.findtype -side right
514 # for making sure type==Exact whenever loc==Pickaxe
515 trace add variable findloc write findlocchange
517 label .ctop.top.lbar.flabel -text "Highlight: Commits touching paths:" \
519 pack .ctop.top.lbar.flabel -side left -fill y
520 entry .ctop.top.lbar.fent -width 25 -font $textfont \
521 -textvariable highlight_files
522 trace add variable highlight_files write hfiles_change
523 lappend entries .ctop.top.lbar.fent
524 pack .ctop.top.lbar.fent -side left -fill x -expand 1
525 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
526 pack .ctop.top.lbar.vlabel -side left -fill y
527 global viewhlmenu selectedhlview
528 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
529 $viewhlmenu entryconf 0 -command delvhighlight
530 pack .ctop.top.lbar.vhl -side left -fill y
531 label .ctop.top.lbar.alabel -text " OR author/committer:" \
533 pack .ctop.top.lbar.alabel -side left -fill y
534 entry .ctop.top.lbar.aent -width 20 -font $textfont \
535 -textvariable highlight_names
536 trace add variable highlight_names write hnames_change
537 lappend entries .ctop.top.lbar.aent
538 pack .ctop.top.lbar.aent -side right -fill x -expand 1
540 panedwindow .ctop.cdet -orient horizontal
542 frame .ctop.cdet.left
543 set ctext .ctop.cdet.left.ctext
544 text $ctext -bg white -state disabled -font $textfont \
545 -width $geometry(ctextw) -height $geometry(ctexth) \
546 -yscrollcommand {.ctop.cdet.left.sb set} -wrap none
547 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
548 pack .ctop.cdet.left.sb -side right -fill y
549 pack $ctext -side left -fill both -expand 1
550 .ctop.cdet add .ctop.cdet.left
552 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
553 $ctext tag conf hunksep -fore blue
554 $ctext tag conf d0 -fore red
555 $ctext tag conf d1 -fore "#00a000"
556 $ctext tag conf m0 -fore red
557 $ctext tag conf m1 -fore blue
558 $ctext tag conf m2 -fore green
559 $ctext tag conf m3 -fore purple
560 $ctext tag conf m4 -fore brown
561 $ctext tag conf m5 -fore "#009090"
562 $ctext tag conf m6 -fore magenta
563 $ctext tag conf m7 -fore "#808000"
564 $ctext tag conf m8 -fore "#009000"
565 $ctext tag conf m9 -fore "#ff0080"
566 $ctext tag conf m10 -fore cyan
567 $ctext tag conf m11 -fore "#b07070"
568 $ctext tag conf m12 -fore "#70b0f0"
569 $ctext tag conf m13 -fore "#70f0b0"
570 $ctext tag conf m14 -fore "#f0b070"
571 $ctext tag conf m15 -fore "#ff70b0"
572 $ctext tag conf mmax -fore darkgrey
574 $ctext tag conf mresult -font [concat $textfont bold]
575 $ctext tag conf msep -font [concat $textfont bold]
576 $ctext tag conf found -back yellow
578 frame .ctop.cdet.right
579 frame .ctop.cdet.right.mode
580 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
581 -command reselectline -variable cmitmode -value "patch"
582 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
583 -command reselectline -variable cmitmode -value "tree"
584 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
585 pack .ctop.cdet.right.mode -side top -fill x
586 set cflist .ctop.cdet.right.cfiles
587 set indent [font measure $mainfont "nn"]
588 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
589 -tabs [list $indent [expr {2 * $indent}]] \
590 -yscrollcommand ".ctop.cdet.right.sb set" \
591 -cursor [. cget -cursor] \
592 -spacing1 1 -spacing3 1
593 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
594 pack .ctop.cdet.right.sb -side right -fill y
595 pack $cflist -side left -fill both -expand 1
596 $cflist tag configure highlight \
597 -background [$cflist cget -selectbackground]
598 .ctop.cdet add .ctop.cdet.right
599 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
601 pack .ctop -side top -fill both -expand 1
603 bindall <1> {selcanvline %W %x %y}
604 #bindall <B1-Motion> {selcanvline %W %x %y}
605 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
606 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
607 bindall <2> "canvscan mark %W %x %y"
608 bindall <B2-Motion> "canvscan dragto %W %x %y"
609 bindkey <Home> selfirstline
610 bindkey <End> sellastline
611 bind . <Key-Up> "selnextline -1"
612 bind . <Key-Down> "selnextline 1"
613 bindkey <Key-Right> "goforw"
614 bindkey <Key-Left> "goback"
615 bind . <Key-Prior> "selnextpage -1"
616 bind . <Key-Next> "selnextpage 1"
617 bind . <Control-Home> "allcanvs yview moveto 0.0"
618 bind . <Control-End> "allcanvs yview moveto 1.0"
619 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
620 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
621 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
622 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
623 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
624 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
625 bindkey <Key-space> "$ctext yview scroll 1 pages"
626 bindkey p "selnextline -1"
627 bindkey n "selnextline 1"
630 bindkey i "selnextline -1"
631 bindkey k "selnextline 1"
634 bindkey b "$ctext yview scroll -1 pages"
635 bindkey d "$ctext yview scroll 18 units"
636 bindkey u "$ctext yview scroll -18 units"
637 bindkey / {findnext 1}
638 bindkey <Key-Return> {findnext 0}
641 bind . <Control-q> doquit
642 bind . <Control-f> dofind
643 bind . <Control-g> {findnext 0}
644 bind . <Control-r> findprev
645 bind . <Control-equal> {incrfont 1}
646 bind . <Control-KP_Add> {incrfont 1}
647 bind . <Control-minus> {incrfont -1}
648 bind . <Control-KP_Subtract> {incrfont -1}
649 bind . <Destroy> {savestuff %W}
650 bind . <Button-1> "click %W"
651 bind $fstring <Key-Return> dofind
652 bind $sha1entry <Key-Return> gotocommit
653 bind $sha1entry <<PasteSelection>> clearsha1
654 bind $cflist <1> {sel_flist %W %x %y; break}
655 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
656 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
658 set maincursor [. cget -cursor]
659 set textcursor [$ctext cget -cursor]
660 set curtextcursor $textcursor
662 set rowctxmenu .rowctxmenu
663 menu $rowctxmenu -tearoff 0
664 $rowctxmenu add command -label "Diff this -> selected" \
665 -command {diffvssel 0}
666 $rowctxmenu add command -label "Diff selected -> this" \
667 -command {diffvssel 1}
668 $rowctxmenu add command -label "Make patch" -command mkpatch
669 $rowctxmenu add command -label "Create tag" -command mktag
670 $rowctxmenu add command -label "Write commit to file" -command writecommit
673 # mouse-2 makes all windows scan vertically, but only the one
674 # the cursor is in scans horizontally
675 proc canvscan {op w x y} {
676 global canv canv2 canv3
677 foreach c [list $canv $canv2 $canv3] {
686 proc scrollcanv {cscroll f0 f1} {
692 # when we make a key binding for the toplevel, make sure
693 # it doesn't get triggered when that key is pressed in the
694 # find string entry widget.
695 proc bindkey {ev script} {
698 set escript [bind Entry $ev]
699 if {$escript == {}} {
700 set escript [bind Entry <Key>]
703 bind $e $ev "$escript; break"
707 # set the focus back to the toplevel for any click outside
718 global canv canv2 canv3 ctext cflist mainfont textfont uifont
719 global stuffsaved findmergefiles maxgraphpct
721 global viewname viewfiles viewargs viewperm nextviewnum
724 if {$stuffsaved} return
725 if {![winfo viewable .]} return
727 set f [open "~/.gitk-new" w]
728 puts $f [list set mainfont $mainfont]
729 puts $f [list set textfont $textfont]
730 puts $f [list set uifont $uifont]
731 puts $f [list set findmergefiles $findmergefiles]
732 puts $f [list set maxgraphpct $maxgraphpct]
733 puts $f [list set maxwidth $maxwidth]
734 puts $f [list set cmitmode $cmitmode]
735 puts $f "set geometry(width) [winfo width .ctop]"
736 puts $f "set geometry(height) [winfo height .ctop]"
737 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
738 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
739 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
740 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
741 set wid [expr {([winfo width $ctext] - 8) \
742 / [font measure $textfont "0"]}]
743 puts $f "set geometry(ctextw) $wid"
744 set wid [expr {([winfo width $cflist] - 11) \
745 / [font measure [$cflist cget -font] "0"]}]
746 puts $f "set geometry(cflistw) $wid"
747 puts -nonewline $f "set permviews {"
748 for {set v 0} {$v < $nextviewnum} {incr v} {
750 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
755 file rename -force "~/.gitk-new" "~/.gitk"
760 proc resizeclistpanes {win w} {
762 if {[info exists oldwidth($win)]} {
763 set s0 [$win sash coord 0]
764 set s1 [$win sash coord 1]
766 set sash0 [expr {int($w/2 - 2)}]
767 set sash1 [expr {int($w*5/6 - 2)}]
769 set factor [expr {1.0 * $w / $oldwidth($win)}]
770 set sash0 [expr {int($factor * [lindex $s0 0])}]
771 set sash1 [expr {int($factor * [lindex $s1 0])}]
775 if {$sash1 < $sash0 + 20} {
776 set sash1 [expr {$sash0 + 20}]
778 if {$sash1 > $w - 10} {
779 set sash1 [expr {$w - 10}]
780 if {$sash0 > $sash1 - 20} {
781 set sash0 [expr {$sash1 - 20}]
785 $win sash place 0 $sash0 [lindex $s0 1]
786 $win sash place 1 $sash1 [lindex $s1 1]
788 set oldwidth($win) $w
791 proc resizecdetpanes {win w} {
793 if {[info exists oldwidth($win)]} {
794 set s0 [$win sash coord 0]
796 set sash0 [expr {int($w*3/4 - 2)}]
798 set factor [expr {1.0 * $w / $oldwidth($win)}]
799 set sash0 [expr {int($factor * [lindex $s0 0])}]
803 if {$sash0 > $w - 15} {
804 set sash0 [expr {$w - 15}]
807 $win sash place 0 $sash0 [lindex $s0 1]
809 set oldwidth($win) $w
813 global canv canv2 canv3
819 proc bindall {event action} {
820 global canv canv2 canv3
821 bind $canv $event $action
822 bind $canv2 $event $action
823 bind $canv3 $event $action
828 if {[winfo exists $w]} {
833 wm title $w "About gitk"
835 Gitk - a commit viewer for git
837 Copyright © 2005-2006 Paul Mackerras
839 Use and redistribute under the terms of the GNU General Public License} \
840 -justify center -aspect 400
841 pack $w.m -side top -fill x -padx 20 -pady 20
842 button $w.ok -text Close -command "destroy $w"
843 pack $w.ok -side bottom
848 if {[winfo exists $w]} {
853 wm title $w "Gitk key bindings"
858 <Home> Move to first commit
859 <End> Move to last commit
860 <Up>, p, i Move up one commit
861 <Down>, n, k Move down one commit
862 <Left>, z, j Go back in history list
863 <Right>, x, l Go forward in history list
864 <PageUp> Move up one page in commit list
865 <PageDown> Move down one page in commit list
866 <Ctrl-Home> Scroll to top of commit list
867 <Ctrl-End> Scroll to bottom of commit list
868 <Ctrl-Up> Scroll commit list up one line
869 <Ctrl-Down> Scroll commit list down one line
870 <Ctrl-PageUp> Scroll commit list up one page
871 <Ctrl-PageDown> Scroll commit list down one page
872 <Delete>, b Scroll diff view up one page
873 <Backspace> Scroll diff view up one page
874 <Space> Scroll diff view down one page
875 u Scroll diff view up 18 lines
876 d Scroll diff view down 18 lines
878 <Ctrl-G> Move to next find hit
879 <Ctrl-R> Move to previous find hit
880 <Return> Move to next find hit
881 / Move to next find hit, or redo find
882 ? Move to previous find hit
883 f Scroll diff view to next file
884 <Ctrl-KP+> Increase font size
885 <Ctrl-plus> Increase font size
886 <Ctrl-KP-> Decrease font size
887 <Ctrl-minus> Decrease font size
889 -justify left -bg white -border 2 -relief sunken
890 pack $w.m -side top -fill both
891 button $w.ok -text Close -command "destroy $w"
892 pack $w.ok -side bottom
895 # Procedures for manipulating the file list window at the
896 # bottom right of the overall window.
898 proc treeview {w l openlevs} {
899 global treecontents treediropen treeheight treeparent treeindex
909 set treecontents() {}
910 $w conf -state normal
912 while {[string range $f 0 $prefixend] ne $prefix} {
913 if {$lev <= $openlevs} {
914 $w mark set e:$treeindex($prefix) "end -1c"
915 $w mark gravity e:$treeindex($prefix) left
917 set treeheight($prefix) $ht
918 incr ht [lindex $htstack end]
919 set htstack [lreplace $htstack end end]
920 set prefixend [lindex $prefendstack end]
921 set prefendstack [lreplace $prefendstack end end]
922 set prefix [string range $prefix 0 $prefixend]
925 set tail [string range $f [expr {$prefixend+1}] end]
926 while {[set slash [string first "/" $tail]] >= 0} {
929 lappend prefendstack $prefixend
930 incr prefixend [expr {$slash + 1}]
931 set d [string range $tail 0 $slash]
932 lappend treecontents($prefix) $d
933 set oldprefix $prefix
935 set treecontents($prefix) {}
936 set treeindex($prefix) [incr ix]
937 set treeparent($prefix) $oldprefix
938 set tail [string range $tail [expr {$slash+1}] end]
939 if {$lev <= $openlevs} {
941 set treediropen($prefix) [expr {$lev < $openlevs}]
942 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
943 $w mark set d:$ix "end -1c"
944 $w mark gravity d:$ix left
946 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
948 $w image create end -align center -image $bm -padx 1 \
951 $w mark set s:$ix "end -1c"
952 $w mark gravity s:$ix left
957 if {$lev <= $openlevs} {
960 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
964 lappend treecontents($prefix) $tail
967 while {$htstack ne {}} {
968 set treeheight($prefix) $ht
969 incr ht [lindex $htstack end]
970 set htstack [lreplace $htstack end end]
972 $w conf -state disabled
976 global treeheight treecontents
981 foreach e $treecontents($prefix) {
986 if {[string index $e end] eq "/"} {
987 set n $treeheight($prefix$e)
999 proc treeclosedir {w dir} {
1000 global treediropen treeheight treeparent treeindex
1002 set ix $treeindex($dir)
1003 $w conf -state normal
1004 $w delete s:$ix e:$ix
1005 set treediropen($dir) 0
1006 $w image configure a:$ix -image tri-rt
1007 $w conf -state disabled
1008 set n [expr {1 - $treeheight($dir)}]
1009 while {$dir ne {}} {
1010 incr treeheight($dir) $n
1011 set dir $treeparent($dir)
1015 proc treeopendir {w dir} {
1016 global treediropen treeheight treeparent treecontents treeindex
1018 set ix $treeindex($dir)
1019 $w conf -state normal
1020 $w image configure a:$ix -image tri-dn
1021 $w mark set e:$ix s:$ix
1022 $w mark gravity e:$ix right
1025 set n [llength $treecontents($dir)]
1026 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1029 incr treeheight($x) $n
1031 foreach e $treecontents($dir) {
1032 if {[string index $e end] eq "/"} {
1034 set iy $treeindex($de)
1035 $w mark set d:$iy e:$ix
1036 $w mark gravity d:$iy left
1037 $w insert e:$ix $str
1038 set treediropen($de) 0
1039 $w image create e:$ix -align center -image tri-rt -padx 1 \
1042 $w mark set s:$iy e:$ix
1043 $w mark gravity s:$iy left
1044 set treeheight($de) 1
1046 $w insert e:$ix $str
1050 $w mark gravity e:$ix left
1051 $w conf -state disabled
1052 set treediropen($dir) 1
1053 set top [lindex [split [$w index @0,0] .] 0]
1054 set ht [$w cget -height]
1055 set l [lindex [split [$w index s:$ix] .] 0]
1058 } elseif {$l + $n + 1 > $top + $ht} {
1059 set top [expr {$l + $n + 2 - $ht}]
1067 proc treeclick {w x y} {
1068 global treediropen cmitmode ctext cflist cflist_top
1070 if {$cmitmode ne "tree"} return
1071 if {![info exists cflist_top]} return
1072 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1073 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1074 $cflist tag add highlight $l.0 "$l.0 lineend"
1080 set e [linetoelt $l]
1081 if {[string index $e end] ne "/"} {
1083 } elseif {$treediropen($e)} {
1090 proc setfilelist {id} {
1091 global treefilelist cflist
1093 treeview $cflist $treefilelist($id) 0
1096 image create bitmap tri-rt -background black -foreground blue -data {
1097 #define tri-rt_width 13
1098 #define tri-rt_height 13
1099 static unsigned char tri-rt_bits[] = {
1100 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1101 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1104 #define tri-rt-mask_width 13
1105 #define tri-rt-mask_height 13
1106 static unsigned char tri-rt-mask_bits[] = {
1107 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1108 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1111 image create bitmap tri-dn -background black -foreground blue -data {
1112 #define tri-dn_width 13
1113 #define tri-dn_height 13
1114 static unsigned char tri-dn_bits[] = {
1115 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1116 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1119 #define tri-dn-mask_width 13
1120 #define tri-dn-mask_height 13
1121 static unsigned char tri-dn-mask_bits[] = {
1122 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1123 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1127 proc init_flist {first} {
1128 global cflist cflist_top selectedline difffilestart
1130 $cflist conf -state normal
1131 $cflist delete 0.0 end
1133 $cflist insert end $first
1135 $cflist tag add highlight 1.0 "1.0 lineend"
1137 catch {unset cflist_top}
1139 $cflist conf -state disabled
1140 set difffilestart {}
1143 proc add_flist {fl} {
1144 global flistmode cflist
1146 $cflist conf -state normal
1147 if {$flistmode eq "flat"} {
1149 $cflist insert end "\n$f"
1152 $cflist conf -state disabled
1155 proc sel_flist {w x y} {
1156 global flistmode ctext difffilestart cflist cflist_top cmitmode
1158 if {$cmitmode eq "tree"} return
1159 if {![info exists cflist_top]} return
1160 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1161 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1162 $cflist tag add highlight $l.0 "$l.0 lineend"
1167 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1171 # Functions for adding and removing shell-type quoting
1173 proc shellquote {str} {
1174 if {![string match "*\['\"\\ \t]*" $str]} {
1177 if {![string match "*\['\"\\]*" $str]} {
1180 if {![string match "*'*" $str]} {
1183 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1186 proc shellarglist {l} {
1192 append str [shellquote $a]
1197 proc shelldequote {str} {
1202 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1203 append ret [string range $str $used end]
1204 set used [string length $str]
1207 set first [lindex $first 0]
1208 set ch [string index $str $first]
1209 if {$first > $used} {
1210 append ret [string range $str $used [expr {$first - 1}]]
1213 if {$ch eq " " || $ch eq "\t"} break
1216 set first [string first "'" $str $used]
1218 error "unmatched single-quote"
1220 append ret [string range $str $used [expr {$first - 1}]]
1225 if {$used >= [string length $str]} {
1226 error "trailing backslash"
1228 append ret [string index $str $used]
1233 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1234 error "unmatched double-quote"
1236 set first [lindex $first 0]
1237 set ch [string index $str $first]
1238 if {$first > $used} {
1239 append ret [string range $str $used [expr {$first - 1}]]
1242 if {$ch eq "\""} break
1244 append ret [string index $str $used]
1248 return [list $used $ret]
1251 proc shellsplit {str} {
1254 set str [string trimleft $str]
1255 if {$str eq {}} break
1256 set dq [shelldequote $str]
1257 set n [lindex $dq 0]
1258 set word [lindex $dq 1]
1259 set str [string range $str $n end]
1265 # Code to implement multiple views
1267 proc newview {ishighlight} {
1268 global nextviewnum newviewname newviewperm uifont newishighlight
1269 global newviewargs revtreeargs
1271 set newishighlight $ishighlight
1273 if {[winfo exists $top]} {
1277 set newviewname($nextviewnum) "View $nextviewnum"
1278 set newviewperm($nextviewnum) 0
1279 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1280 vieweditor $top $nextviewnum "Gitk view definition"
1285 global viewname viewperm newviewname newviewperm
1286 global viewargs newviewargs
1288 set top .gitkvedit-$curview
1289 if {[winfo exists $top]} {
1293 set newviewname($curview) $viewname($curview)
1294 set newviewperm($curview) $viewperm($curview)
1295 set newviewargs($curview) [shellarglist $viewargs($curview)]
1296 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1299 proc vieweditor {top n title} {
1300 global newviewname newviewperm viewfiles
1304 wm title $top $title
1305 label $top.nl -text "Name" -font $uifont
1306 entry $top.name -width 20 -textvariable newviewname($n)
1307 grid $top.nl $top.name -sticky w -pady 5
1308 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1309 grid $top.perm - -pady 5 -sticky w
1310 message $top.al -aspect 1000 -font $uifont \
1311 -text "Commits to include (arguments to git-rev-list):"
1312 grid $top.al - -sticky w -pady 5
1313 entry $top.args -width 50 -textvariable newviewargs($n) \
1315 grid $top.args - -sticky ew -padx 5
1316 message $top.l -aspect 1000 -font $uifont \
1317 -text "Enter files and directories to include, one per line:"
1318 grid $top.l - -sticky w
1319 text $top.t -width 40 -height 10 -background white
1320 if {[info exists viewfiles($n)]} {
1321 foreach f $viewfiles($n) {
1322 $top.t insert end $f
1323 $top.t insert end "\n"
1325 $top.t delete {end - 1c} end
1326 $top.t mark set insert 0.0
1328 grid $top.t - -sticky ew -padx 5
1330 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1331 button $top.buts.can -text "Cancel" -command [list destroy $top]
1332 grid $top.buts.ok $top.buts.can
1333 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1334 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1335 grid $top.buts - -pady 10 -sticky ew
1339 proc doviewmenu {m first cmd op argv} {
1340 set nmenu [$m index end]
1341 for {set i $first} {$i <= $nmenu} {incr i} {
1342 if {[$m entrycget $i -command] eq $cmd} {
1343 eval $m $op $i $argv
1349 proc allviewmenus {n op args} {
1352 doviewmenu .bar.view 7 [list showview $n] $op $args
1353 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1356 proc newviewok {top n} {
1357 global nextviewnum newviewperm newviewname newishighlight
1358 global viewname viewfiles viewperm selectedview curview
1359 global viewargs newviewargs viewhlmenu
1362 set newargs [shellsplit $newviewargs($n)]
1364 error_popup "Error in commit selection arguments: $err"
1370 foreach f [split [$top.t get 0.0 end] "\n"] {
1371 set ft [string trim $f]
1376 if {![info exists viewfiles($n)]} {
1377 # creating a new view
1379 set viewname($n) $newviewname($n)
1380 set viewperm($n) $newviewperm($n)
1381 set viewfiles($n) $files
1382 set viewargs($n) $newargs
1384 if {!$newishighlight} {
1385 after idle showview $n
1387 after idle addvhighlight $n
1390 # editing an existing view
1391 set viewperm($n) $newviewperm($n)
1392 if {$newviewname($n) ne $viewname($n)} {
1393 set viewname($n) $newviewname($n)
1394 doviewmenu .bar.view 7 [list showview $n] \
1395 entryconf [list -label $viewname($n)]
1396 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1397 entryconf [list -label $viewname($n) -value $viewname($n)]
1399 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1400 set viewfiles($n) $files
1401 set viewargs($n) $newargs
1402 if {$curview == $n} {
1403 after idle updatecommits
1407 catch {destroy $top}
1411 global curview viewdata viewperm hlview selectedhlview
1413 if {$curview == 0} return
1414 if {[info exists hlview] && $hlview == $curview} {
1415 set selectedhlview None
1418 allviewmenus $curview delete
1419 set viewdata($curview) {}
1420 set viewperm($curview) 0
1424 proc addviewmenu {n} {
1425 global viewname viewhlmenu
1427 .bar.view add radiobutton -label $viewname($n) \
1428 -command [list showview $n] -variable selectedview -value $n
1429 $viewhlmenu add radiobutton -label $viewname($n) \
1430 -command [list addvhighlight $n] -variable selectedhlview
1433 proc flatten {var} {
1437 foreach i [array names $var] {
1438 lappend ret $i [set $var\($i\)]
1443 proc unflatten {var l} {
1453 global curview viewdata viewfiles
1454 global displayorder parentlist childlist rowidlist rowoffsets
1455 global colormap rowtextx commitrow nextcolor canvxmax
1456 global numcommits rowrangelist commitlisted idrowranges
1457 global selectedline currentid canv canvy0
1458 global matchinglines treediffs
1459 global pending_select phase
1460 global commitidx rowlaidout rowoptim linesegends
1461 global commfd nextupdate
1463 global vparentlist vchildlist vdisporder vcmitlisted
1464 global hlview selectedhlview
1466 if {$n == $curview} return
1468 if {[info exists selectedline]} {
1469 set selid $currentid
1470 set y [yc $selectedline]
1471 set ymax [lindex [$canv cget -scrollregion] 3]
1472 set span [$canv yview]
1473 set ytop [expr {[lindex $span 0] * $ymax}]
1474 set ybot [expr {[lindex $span 1] * $ymax}]
1475 if {$ytop < $y && $y < $ybot} {
1476 set yscreen [expr {$y - $ytop}]
1478 set yscreen [expr {($ybot - $ytop) / 2}]
1484 if {$curview >= 0} {
1485 set vparentlist($curview) $parentlist
1486 set vchildlist($curview) $childlist
1487 set vdisporder($curview) $displayorder
1488 set vcmitlisted($curview) $commitlisted
1490 set viewdata($curview) \
1491 [list $phase $rowidlist $rowoffsets $rowrangelist \
1492 [flatten idrowranges] [flatten idinlist] \
1493 $rowlaidout $rowoptim $numcommits $linesegends]
1494 } elseif {![info exists viewdata($curview)]
1495 || [lindex $viewdata($curview) 0] ne {}} {
1496 set viewdata($curview) \
1497 [list {} $rowidlist $rowoffsets $rowrangelist]
1500 catch {unset matchinglines}
1501 catch {unset treediffs}
1503 if {[info exists hlview] && $hlview == $n} {
1505 set selectedhlview None
1510 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1511 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1513 if {![info exists viewdata($n)]} {
1514 set pending_select $selid
1520 set phase [lindex $v 0]
1521 set displayorder $vdisporder($n)
1522 set parentlist $vparentlist($n)
1523 set childlist $vchildlist($n)
1524 set commitlisted $vcmitlisted($n)
1525 set rowidlist [lindex $v 1]
1526 set rowoffsets [lindex $v 2]
1527 set rowrangelist [lindex $v 3]
1529 set numcommits [llength $displayorder]
1530 catch {unset idrowranges}
1532 unflatten idrowranges [lindex $v 4]
1533 unflatten idinlist [lindex $v 5]
1534 set rowlaidout [lindex $v 6]
1535 set rowoptim [lindex $v 7]
1536 set numcommits [lindex $v 8]
1537 set linesegends [lindex $v 9]
1540 catch {unset colormap}
1541 catch {unset rowtextx}
1543 set canvxmax [$canv cget -width]
1549 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1550 set row $commitrow($n,$selid)
1551 # try to get the selected row in the same position on the screen
1552 set ymax [lindex [$canv cget -scrollregion] 3]
1553 set ytop [expr {[yc $row] - $yscreen}]
1557 set yf [expr {$ytop * 1.0 / $ymax}]
1559 allcanvs yview moveto $yf
1563 if {$phase eq "getcommits"} {
1564 show_status "Reading commits..."
1566 if {[info exists commfd($n)]} {
1571 } elseif {$numcommits == 0} {
1572 show_status "No commits selected"
1576 # Stuff relating to the highlighting facility
1578 proc ishighlighted {row} {
1579 global vhighlights fhighlights nhighlights
1581 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1582 return $nhighlights($row)
1584 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1585 return $vhighlights($row)
1587 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1588 return $fhighlights($row)
1593 proc bolden {row font} {
1594 global canv linehtag selectedline
1596 $canv itemconf $linehtag($row) -font $font
1597 if {$row == $selectedline} {
1599 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1600 -outline {{}} -tags secsel \
1601 -fill [$canv cget -selectbackground]]
1606 proc bolden_name {row font} {
1607 global canv2 linentag selectedline
1609 $canv2 itemconf $linentag($row) -font $font
1610 if {$row == $selectedline} {
1611 $canv2 delete secsel
1612 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1613 -outline {{}} -tags secsel \
1614 -fill [$canv2 cget -selectbackground]]
1619 proc unbolden {rows} {
1623 if {![ishighlighted $row]} {
1624 bolden $row $mainfont
1629 proc addvhighlight {n} {
1630 global hlview curview viewdata vhl_done vhighlights commitidx
1632 if {[info exists hlview]} {
1636 if {$n != $curview && ![info exists viewdata($n)]} {
1637 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1638 set vparentlist($n) {}
1639 set vchildlist($n) {}
1640 set vdisporder($n) {}
1641 set vcmitlisted($n) {}
1644 set vhl_done $commitidx($hlview)
1645 if {$vhl_done > 0} {
1650 proc delvhighlight {} {
1651 global hlview vhighlights
1654 if {![info exists hlview]} return
1656 set rows [array names vhighlights]
1663 proc vhighlightmore {} {
1664 global hlview vhl_done commitidx vhighlights
1665 global displayorder vdisporder curview mainfont
1667 set font [concat $mainfont bold]
1668 set max $commitidx($hlview)
1669 if {$hlview == $curview} {
1670 set disp $displayorder
1672 set disp $vdisporder($hlview)
1674 set vr [visiblerows]
1675 set r0 [lindex $vr 0]
1676 set r1 [lindex $vr 1]
1677 for {set i $vhl_done} {$i < $max} {incr i} {
1678 set id [lindex $disp $i]
1679 if {[info exists commitrow($curview,$id)]} {
1680 set row $commitrow($curview,$id)
1681 if {$r0 <= $row && $row <= $r1} {
1682 if {![highlighted $row]} {
1685 set vhighlights($row) 1
1692 proc askvhighlight {row id} {
1693 global hlview vhighlights commitrow iddrawn mainfont
1695 if {[info exists commitrow($hlview,$id)]} {
1696 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1697 bolden $row [concat $mainfont bold]
1699 set vhighlights($row) 1
1701 set vhighlights($row) 0
1705 proc hfiles_change {name ix op} {
1706 global highlight_files filehighlight fhighlights fh_serial
1709 if {[info exists filehighlight]} {
1710 # delete previous highlights
1711 catch {close $filehighlight}
1713 set rows [array names fhighlights]
1719 after cancel do_file_hl $fh_serial
1721 if {$highlight_files ne {}} {
1722 after 300 do_file_hl $fh_serial
1726 proc do_file_hl {serial} {
1727 global highlight_files filehighlight
1729 if {[catch {set paths [shellsplit $highlight_files]}]} return
1730 set cmd [concat | git-diff-tree -r -s --stdin -- $paths]
1731 set filehighlight [open $cmd r+]
1732 fconfigure $filehighlight -blocking 0
1733 fileevent $filehighlight readable readfhighlight
1738 proc flushhighlights {} {
1739 global filehighlight
1741 if {[info exists filehighlight]} {
1742 puts $filehighlight ""
1743 flush $filehighlight
1747 proc askfilehighlight {row id} {
1748 global filehighlight fhighlights
1750 set fhighlights($row) 0
1751 puts $filehighlight $id
1754 proc readfhighlight {} {
1755 global filehighlight fhighlights commitrow curview mainfont iddrawn
1757 set n [gets $filehighlight line]
1759 if {[eof $filehighlight]} {
1761 puts "oops, git-diff-tree died"
1762 catch {close $filehighlight}
1767 set line [string trim $line]
1768 if {$line eq {}} return
1769 if {![info exists commitrow($curview,$line)]} return
1770 set row $commitrow($curview,$line)
1771 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1772 bolden $row [concat $mainfont bold]
1774 set fhighlights($row) 1
1777 proc hnames_change {name ix op} {
1778 global highlight_names nhighlights nhl_names mainfont
1780 # delete previous highlights, if any
1781 set rows [array names nhighlights]
1784 if {$nhighlights($row) >= 2} {
1785 bolden_name $row $mainfont
1791 if {[catch {set nhl_names [shellsplit $highlight_names]}]} {
1798 proc asknamehighlight {row id} {
1799 global nhl_names nhighlights commitinfo iddrawn mainfont
1801 if {![info exists commitinfo($id)]} {
1805 set author [lindex $commitinfo($id) 1]
1806 set committer [lindex $commitinfo($id) 3]
1807 foreach name $nhl_names {
1808 set pattern "*$name*"
1809 if {[string match -nocase $pattern $author]} {
1813 if {!$isbold && [string match -nocase $pattern $committer]} {
1817 if {[info exists iddrawn($id)]} {
1818 if {$isbold && ![ishighlighted $row]} {
1819 bolden $row [concat $mainfont bold]
1822 bolden_name $row [concat $mainfont bold]
1825 set nhighlights($row) $isbold
1828 # Graph layout functions
1830 proc shortids {ids} {
1833 if {[llength $id] > 1} {
1834 lappend res [shortids $id]
1835 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
1836 lappend res [string range $id 0 7]
1844 proc incrange {l x o} {
1847 set e [lindex $l $x]
1849 lset l $x [expr {$e + $o}]
1858 for {} {$n > 0} {incr n -1} {
1864 proc usedinrange {id l1 l2} {
1865 global children commitrow childlist curview
1867 if {[info exists commitrow($curview,$id)]} {
1868 set r $commitrow($curview,$id)
1869 if {$l1 <= $r && $r <= $l2} {
1870 return [expr {$r - $l1 + 1}]
1872 set kids [lindex $childlist $r]
1874 set kids $children($curview,$id)
1877 set r $commitrow($curview,$c)
1878 if {$l1 <= $r && $r <= $l2} {
1879 return [expr {$r - $l1 + 1}]
1885 proc sanity {row {full 0}} {
1886 global rowidlist rowoffsets
1889 set ids [lindex $rowidlist $row]
1892 if {$id eq {}} continue
1893 if {$col < [llength $ids] - 1 &&
1894 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
1895 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
1897 set o [lindex $rowoffsets $row $col]
1903 if {[lindex $rowidlist $y $x] != $id} {
1904 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
1905 puts " id=[shortids $id] check started at row $row"
1906 for {set i $row} {$i >= $y} {incr i -1} {
1907 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
1912 set o [lindex $rowoffsets $y $x]
1917 proc makeuparrow {oid x y z} {
1918 global rowidlist rowoffsets uparrowlen idrowranges
1920 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
1923 set off0 [lindex $rowoffsets $y]
1924 for {set x0 $x} {1} {incr x0} {
1925 if {$x0 >= [llength $off0]} {
1926 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
1929 set z [lindex $off0 $x0]
1935 set z [expr {$x0 - $x}]
1936 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
1937 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
1939 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
1940 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
1941 lappend idrowranges($oid) $y
1944 proc initlayout {} {
1945 global rowidlist rowoffsets displayorder commitlisted
1946 global rowlaidout rowoptim
1947 global idinlist rowchk rowrangelist idrowranges
1948 global numcommits canvxmax canv
1950 global parentlist childlist children
1951 global colormap rowtextx
1963 catch {unset idinlist}
1964 catch {unset rowchk}
1967 set canvxmax [$canv cget -width]
1968 catch {unset colormap}
1969 catch {unset rowtextx}
1970 catch {unset idrowranges}
1974 proc setcanvscroll {} {
1975 global canv canv2 canv3 numcommits linespc canvxmax canvy0
1977 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
1978 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
1979 $canv2 conf -scrollregion [list 0 0 0 $ymax]
1980 $canv3 conf -scrollregion [list 0 0 0 $ymax]
1983 proc visiblerows {} {
1984 global canv numcommits linespc
1986 set ymax [lindex [$canv cget -scrollregion] 3]
1987 if {$ymax eq {} || $ymax == 0} return
1989 set y0 [expr {int([lindex $f 0] * $ymax)}]
1990 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
1994 set y1 [expr {int([lindex $f 1] * $ymax)}]
1995 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
1996 if {$r1 >= $numcommits} {
1997 set r1 [expr {$numcommits - 1}]
1999 return [list $r0 $r1]
2002 proc layoutmore {} {
2003 global rowlaidout rowoptim commitidx numcommits optim_delay
2004 global uparrowlen curview
2007 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2008 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2009 if {$orow > $rowoptim} {
2010 optimize_rows $rowoptim 0 $orow
2013 set canshow [expr {$rowoptim - $optim_delay}]
2014 if {$canshow > $numcommits} {
2019 proc showstuff {canshow} {
2020 global numcommits commitrow pending_select selectedline
2021 global linesegends idrowranges idrangedrawn curview
2023 if {$numcommits == 0} {
2025 set phase "incrdraw"
2029 set numcommits $canshow
2031 set rows [visiblerows]
2032 set r0 [lindex $rows 0]
2033 set r1 [lindex $rows 1]
2035 for {set r $row} {$r < $canshow} {incr r} {
2036 foreach id [lindex $linesegends [expr {$r+1}]] {
2038 foreach {s e} [rowranges $id] {
2040 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2041 && ![info exists idrangedrawn($id,$i)]} {
2043 set idrangedrawn($id,$i) 1
2048 if {$canshow > $r1} {
2051 while {$row < $canshow} {
2055 if {[info exists pending_select] &&
2056 [info exists commitrow($curview,$pending_select)] &&
2057 $commitrow($curview,$pending_select) < $numcommits} {
2058 selectline $commitrow($curview,$pending_select) 1
2060 if {![info exists selectedline] && ![info exists pending_select]} {
2065 proc layoutrows {row endrow last} {
2066 global rowidlist rowoffsets displayorder
2067 global uparrowlen downarrowlen maxwidth mingaplen
2068 global childlist parentlist
2069 global idrowranges linesegends
2070 global commitidx curview
2071 global idinlist rowchk rowrangelist
2073 set idlist [lindex $rowidlist $row]
2074 set offs [lindex $rowoffsets $row]
2075 while {$row < $endrow} {
2076 set id [lindex $displayorder $row]
2079 foreach p [lindex $parentlist $row] {
2080 if {![info exists idinlist($p)]} {
2082 } elseif {!$idinlist($p)} {
2087 set nev [expr {[llength $idlist] + [llength $newolds]
2088 + [llength $oldolds] - $maxwidth + 1}]
2091 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2092 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2093 set i [lindex $idlist $x]
2094 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2095 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2096 [expr {$row + $uparrowlen + $mingaplen}]]
2098 set idlist [lreplace $idlist $x $x]
2099 set offs [lreplace $offs $x $x]
2100 set offs [incrange $offs $x 1]
2102 set rm1 [expr {$row - 1}]
2104 lappend idrowranges($i) $rm1
2105 if {[incr nev -1] <= 0} break
2108 set rowchk($id) [expr {$row + $r}]
2111 lset rowidlist $row $idlist
2112 lset rowoffsets $row $offs
2114 lappend linesegends $lse
2115 set col [lsearch -exact $idlist $id]
2117 set col [llength $idlist]
2119 lset rowidlist $row $idlist
2121 if {[lindex $childlist $row] ne {}} {
2122 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2126 lset rowoffsets $row $offs
2128 makeuparrow $id $col $row $z
2134 if {[info exists idrowranges($id)]} {
2135 set ranges $idrowranges($id)
2137 unset idrowranges($id)
2139 lappend rowrangelist $ranges
2141 set offs [ntimes [llength $idlist] 0]
2142 set l [llength $newolds]
2143 set idlist [eval lreplace \$idlist $col $col $newolds]
2146 set offs [lrange $offs 0 [expr {$col - 1}]]
2147 foreach x $newolds {
2152 set tmp [expr {[llength $idlist] - [llength $offs]}]
2154 set offs [concat $offs [ntimes $tmp $o]]
2159 foreach i $newolds {
2161 set idrowranges($i) $row
2164 foreach oid $oldolds {
2165 set idinlist($oid) 1
2166 set idlist [linsert $idlist $col $oid]
2167 set offs [linsert $offs $col $o]
2168 makeuparrow $oid $col $row $o
2171 lappend rowidlist $idlist
2172 lappend rowoffsets $offs
2177 proc addextraid {id row} {
2178 global displayorder commitrow commitinfo
2179 global commitidx commitlisted
2180 global parentlist childlist children curview
2182 incr commitidx($curview)
2183 lappend displayorder $id
2184 lappend commitlisted 0
2185 lappend parentlist {}
2186 set commitrow($curview,$id) $row
2188 if {![info exists commitinfo($id)]} {
2189 set commitinfo($id) {"No commit information available"}
2191 if {![info exists children($curview,$id)]} {
2192 set children($curview,$id) {}
2194 lappend childlist $children($curview,$id)
2197 proc layouttail {} {
2198 global rowidlist rowoffsets idinlist commitidx curview
2199 global idrowranges rowrangelist
2201 set row $commitidx($curview)
2202 set idlist [lindex $rowidlist $row]
2203 while {$idlist ne {}} {
2204 set col [expr {[llength $idlist] - 1}]
2205 set id [lindex $idlist $col]
2208 lappend idrowranges($id) $row
2209 lappend rowrangelist $idrowranges($id)
2210 unset idrowranges($id)
2212 set offs [ntimes $col 0]
2213 set idlist [lreplace $idlist $col $col]
2214 lappend rowidlist $idlist
2215 lappend rowoffsets $offs
2218 foreach id [array names idinlist] {
2220 lset rowidlist $row [list $id]
2221 lset rowoffsets $row 0
2222 makeuparrow $id 0 $row 0
2223 lappend idrowranges($id) $row
2224 lappend rowrangelist $idrowranges($id)
2225 unset idrowranges($id)
2227 lappend rowidlist {}
2228 lappend rowoffsets {}
2232 proc insert_pad {row col npad} {
2233 global rowidlist rowoffsets
2235 set pad [ntimes $npad {}]
2236 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2237 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2238 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2241 proc optimize_rows {row col endrow} {
2242 global rowidlist rowoffsets idrowranges displayorder
2244 for {} {$row < $endrow} {incr row} {
2245 set idlist [lindex $rowidlist $row]
2246 set offs [lindex $rowoffsets $row]
2248 for {} {$col < [llength $offs]} {incr col} {
2249 if {[lindex $idlist $col] eq {}} {
2253 set z [lindex $offs $col]
2254 if {$z eq {}} continue
2256 set x0 [expr {$col + $z}]
2257 set y0 [expr {$row - 1}]
2258 set z0 [lindex $rowoffsets $y0 $x0]
2260 set id [lindex $idlist $col]
2261 set ranges [rowranges $id]
2262 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2266 if {$z < -1 || ($z < 0 && $isarrow)} {
2267 set npad [expr {-1 - $z + $isarrow}]
2268 set offs [incrange $offs $col $npad]
2269 insert_pad $y0 $x0 $npad
2271 optimize_rows $y0 $x0 $row
2273 set z [lindex $offs $col]
2274 set x0 [expr {$col + $z}]
2275 set z0 [lindex $rowoffsets $y0 $x0]
2276 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2277 set npad [expr {$z - 1 + $isarrow}]
2278 set y1 [expr {$row + 1}]
2279 set offs2 [lindex $rowoffsets $y1]
2283 if {$z eq {} || $x1 + $z < $col} continue
2284 if {$x1 + $z > $col} {
2287 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2290 set pad [ntimes $npad {}]
2291 set idlist [eval linsert \$idlist $col $pad]
2292 set tmp [eval linsert \$offs $col $pad]
2294 set offs [incrange $tmp $col [expr {-$npad}]]
2295 set z [lindex $offs $col]
2298 if {$z0 eq {} && !$isarrow} {
2299 # this line links to its first child on row $row-2
2300 set rm2 [expr {$row - 2}]
2301 set id [lindex $displayorder $rm2]
2302 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2304 set z0 [expr {$xc - $x0}]
2307 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2308 insert_pad $y0 $x0 1
2309 set offs [incrange $offs $col 1]
2310 optimize_rows $y0 [expr {$x0 + 1}] $row
2315 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2316 set o [lindex $offs $col]
2318 # check if this is the link to the first child
2319 set id [lindex $idlist $col]
2320 set ranges [rowranges $id]
2321 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2322 # it is, work out offset to child
2323 set y0 [expr {$row - 1}]
2324 set id [lindex $displayorder $y0]
2325 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2327 set o [expr {$x0 - $col}]
2331 if {$o eq {} || $o <= 0} break
2333 if {$o ne {} && [incr col] < [llength $idlist]} {
2334 set y1 [expr {$row + 1}]
2335 set offs2 [lindex $rowoffsets $y1]
2339 if {$z eq {} || $x1 + $z < $col} continue
2340 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2343 set idlist [linsert $idlist $col {}]
2344 set tmp [linsert $offs $col {}]
2346 set offs [incrange $tmp $col -1]
2349 lset rowidlist $row $idlist
2350 lset rowoffsets $row $offs
2356 global canvx0 linespc
2357 return [expr {$canvx0 + $col * $linespc}]
2361 global canvy0 linespc
2362 return [expr {$canvy0 + $row * $linespc}]
2365 proc linewidth {id} {
2366 global thickerline lthickness
2369 if {[info exists thickerline] && $id eq $thickerline} {
2370 set wid [expr {2 * $lthickness}]
2375 proc rowranges {id} {
2376 global phase idrowranges commitrow rowlaidout rowrangelist curview
2380 ([info exists commitrow($curview,$id)]
2381 && $commitrow($curview,$id) < $rowlaidout)} {
2382 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2383 } elseif {[info exists idrowranges($id)]} {
2384 set ranges $idrowranges($id)
2389 proc drawlineseg {id i} {
2390 global rowoffsets rowidlist
2392 global canv colormap linespc
2393 global numcommits commitrow curview
2395 set ranges [rowranges $id]
2397 if {[info exists commitrow($curview,$id)]
2398 && $commitrow($curview,$id) < $numcommits} {
2399 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2403 set startrow [lindex $ranges [expr {2 * $i}]]
2404 set row [lindex $ranges [expr {2 * $i + 1}]]
2405 if {$startrow == $row} return
2408 set col [lsearch -exact [lindex $rowidlist $row] $id]
2410 puts "oops: drawline: id $id not on row $row"
2416 set o [lindex $rowoffsets $row $col]
2419 # changing direction
2420 set x [xc $row $col]
2422 lappend coords $x $y
2428 set x [xc $row $col]
2430 lappend coords $x $y
2432 # draw the link to the first child as part of this line
2434 set child [lindex $displayorder $row]
2435 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2437 set x [xc $row $ccol]
2439 if {$ccol < $col - 1} {
2440 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2441 } elseif {$ccol > $col + 1} {
2442 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2444 lappend coords $x $y
2447 if {[llength $coords] < 4} return
2449 # This line has an arrow at the lower end: check if the arrow is
2450 # on a diagonal segment, and if so, work around the Tk 8.4
2451 # refusal to draw arrows on diagonal lines.
2452 set x0 [lindex $coords 0]
2453 set x1 [lindex $coords 2]
2455 set y0 [lindex $coords 1]
2456 set y1 [lindex $coords 3]
2457 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2458 # we have a nearby vertical segment, just trim off the diag bit
2459 set coords [lrange $coords 2 end]
2461 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2462 set xi [expr {$x0 - $slope * $linespc / 2}]
2463 set yi [expr {$y0 - $linespc / 2}]
2464 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2468 set arrow [expr {2 * ($i > 0) + $downarrow}]
2469 set arrow [lindex {none first last both} $arrow]
2470 set t [$canv create line $coords -width [linewidth $id] \
2471 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2476 proc drawparentlinks {id row col olds} {
2477 global rowidlist canv colormap
2479 set row2 [expr {$row + 1}]
2480 set x [xc $row $col]
2483 set ids [lindex $rowidlist $row2]
2484 # rmx = right-most X coord used
2487 set i [lsearch -exact $ids $p]
2489 puts "oops, parent $p of $id not in list"
2492 set x2 [xc $row2 $i]
2496 set ranges [rowranges $p]
2497 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2498 && $row2 < [lindex $ranges 1]} {
2499 # drawlineseg will do this one for us
2503 # should handle duplicated parents here...
2504 set coords [list $x $y]
2505 if {$i < $col - 1} {
2506 lappend coords [xc $row [expr {$i + 1}]] $y
2507 } elseif {$i > $col + 1} {
2508 lappend coords [xc $row [expr {$i - 1}]] $y
2510 lappend coords $x2 $y2
2511 set t [$canv create line $coords -width [linewidth $p] \
2512 -fill $colormap($p) -tags lines.$p]
2519 proc drawlines {id} {
2520 global colormap canv
2522 global children iddrawn commitrow rowidlist curview
2524 $canv delete lines.$id
2525 set nr [expr {[llength [rowranges $id]] / 2}]
2526 for {set i 0} {$i < $nr} {incr i} {
2527 if {[info exists idrangedrawn($id,$i)]} {
2531 foreach child $children($curview,$id) {
2532 if {[info exists iddrawn($child)]} {
2533 set row $commitrow($curview,$child)
2534 set col [lsearch -exact [lindex $rowidlist $row] $child]
2536 drawparentlinks $child $row $col [list $id]
2542 proc drawcmittext {id row col rmx} {
2543 global linespc canv canv2 canv3 canvy0
2544 global commitlisted commitinfo rowidlist
2545 global rowtextx idpos idtags idheads idotherrefs
2546 global linehtag linentag linedtag
2547 global mainfont canvxmax
2549 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2550 set x [xc $row $col]
2552 set orad [expr {$linespc / 3}]
2553 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2554 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2555 -fill $ofill -outline black -width 1]
2557 $canv bind $t <1> {selcanvline {} %x %y}
2558 set xt [xc $row [llength [lindex $rowidlist $row]]]
2562 set rowtextx($row) $xt
2563 set idpos($id) [list $x $xt $y]
2564 if {[info exists idtags($id)] || [info exists idheads($id)]
2565 || [info exists idotherrefs($id)]} {
2566 set xt [drawtags $id $x $xt $y]
2568 set headline [lindex $commitinfo($id) 0]
2569 set name [lindex $commitinfo($id) 1]
2570 set date [lindex $commitinfo($id) 2]
2571 set date [formatdate $date]
2574 set isbold [ishighlighted $row]
2581 set linehtag($row) [$canv create text $xt $y -anchor w \
2582 -text $headline -font $font]
2583 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2584 set linentag($row) [$canv2 create text 3 $y -anchor w \
2585 -text $name -font $nfont]
2586 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2587 -text $date -font $mainfont]
2588 set xr [expr {$xt + [font measure $mainfont $headline]}]
2589 if {$xr > $canvxmax} {
2595 proc drawcmitrow {row} {
2596 global displayorder rowidlist
2597 global idrangedrawn iddrawn
2598 global commitinfo parentlist numcommits
2599 global filehighlight fhighlights nhl_names nhighlights
2600 global hlview vhighlights
2602 if {$row >= $numcommits} return
2603 foreach id [lindex $rowidlist $row] {
2604 if {$id eq {}} continue
2606 foreach {s e} [rowranges $id] {
2608 if {$row < $s} continue
2611 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2613 set idrangedrawn($id,$i) 1
2620 set id [lindex $displayorder $row]
2621 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2622 askvhighlight $row $id
2624 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2625 askfilehighlight $row $id
2627 if {$nhl_names ne {} && ![info exists nhighlights($row)]} {
2628 asknamehighlight $row $id
2630 if {[info exists iddrawn($id)]} return
2631 set col [lsearch -exact [lindex $rowidlist $row] $id]
2633 puts "oops, row $row id $id not in list"
2636 if {![info exists commitinfo($id)]} {
2640 set olds [lindex $parentlist $row]
2642 set rmx [drawparentlinks $id $row $col $olds]
2646 drawcmittext $id $row $col $rmx
2650 proc drawfrac {f0 f1} {
2651 global numcommits canv
2654 set ymax [lindex [$canv cget -scrollregion] 3]
2655 if {$ymax eq {} || $ymax == 0} return
2656 set y0 [expr {int($f0 * $ymax)}]
2657 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2661 set y1 [expr {int($f1 * $ymax)}]
2662 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2663 if {$endrow >= $numcommits} {
2664 set endrow [expr {$numcommits - 1}]
2666 for {} {$row <= $endrow} {incr row} {
2671 proc drawvisible {} {
2673 eval drawfrac [$canv yview]
2676 proc clear_display {} {
2677 global iddrawn idrangedrawn
2678 global vhighlights fhighlights nhighlights
2681 catch {unset iddrawn}
2682 catch {unset idrangedrawn}
2683 catch {unset vhighlights}
2684 catch {unset fhighlights}
2685 catch {unset nhighlights}
2688 proc findcrossings {id} {
2689 global rowidlist parentlist numcommits rowoffsets displayorder
2693 foreach {s e} [rowranges $id] {
2694 if {$e >= $numcommits} {
2695 set e [expr {$numcommits - 1}]
2697 if {$e <= $s} continue
2698 set x [lsearch -exact [lindex $rowidlist $e] $id]
2700 puts "findcrossings: oops, no [shortids $id] in row $e"
2703 for {set row $e} {[incr row -1] >= $s} {} {
2704 set olds [lindex $parentlist $row]
2705 set kid [lindex $displayorder $row]
2706 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2707 if {$kidx < 0} continue
2708 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2710 set px [lsearch -exact $nextrow $p]
2711 if {$px < 0} continue
2712 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2713 if {[lsearch -exact $ccross $p] >= 0} continue
2714 if {$x == $px + ($kidx < $px? -1: 1)} {
2716 } elseif {[lsearch -exact $cross $p] < 0} {
2721 set inc [lindex $rowoffsets $row $x]
2722 if {$inc eq {}} break
2726 return [concat $ccross {{}} $cross]
2729 proc assigncolor {id} {
2730 global colormap colors nextcolor
2731 global commitrow parentlist children children curview
2733 if {[info exists colormap($id)]} return
2734 set ncolors [llength $colors]
2735 if {[info exists children($curview,$id)]} {
2736 set kids $children($curview,$id)
2740 if {[llength $kids] == 1} {
2741 set child [lindex $kids 0]
2742 if {[info exists colormap($child)]
2743 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2744 set colormap($id) $colormap($child)
2750 foreach x [findcrossings $id] {
2752 # delimiter between corner crossings and other crossings
2753 if {[llength $badcolors] >= $ncolors - 1} break
2754 set origbad $badcolors
2756 if {[info exists colormap($x)]
2757 && [lsearch -exact $badcolors $colormap($x)] < 0} {
2758 lappend badcolors $colormap($x)
2761 if {[llength $badcolors] >= $ncolors} {
2762 set badcolors $origbad
2764 set origbad $badcolors
2765 if {[llength $badcolors] < $ncolors - 1} {
2766 foreach child $kids {
2767 if {[info exists colormap($child)]
2768 && [lsearch -exact $badcolors $colormap($child)] < 0} {
2769 lappend badcolors $colormap($child)
2771 foreach p [lindex $parentlist $commitrow($curview,$child)] {
2772 if {[info exists colormap($p)]
2773 && [lsearch -exact $badcolors $colormap($p)] < 0} {
2774 lappend badcolors $colormap($p)
2778 if {[llength $badcolors] >= $ncolors} {
2779 set badcolors $origbad
2782 for {set i 0} {$i <= $ncolors} {incr i} {
2783 set c [lindex $colors $nextcolor]
2784 if {[incr nextcolor] >= $ncolors} {
2787 if {[lsearch -exact $badcolors $c]} break
2789 set colormap($id) $c
2792 proc bindline {t id} {
2795 $canv bind $t <Enter> "lineenter %x %y $id"
2796 $canv bind $t <Motion> "linemotion %x %y $id"
2797 $canv bind $t <Leave> "lineleave $id"
2798 $canv bind $t <Button-1> "lineclick %x %y $id 1"
2801 proc drawtags {id x xt y1} {
2802 global idtags idheads idotherrefs
2803 global linespc lthickness
2804 global canv mainfont commitrow rowtextx curview
2809 if {[info exists idtags($id)]} {
2810 set marks $idtags($id)
2811 set ntags [llength $marks]
2813 if {[info exists idheads($id)]} {
2814 set marks [concat $marks $idheads($id)]
2815 set nheads [llength $idheads($id)]
2817 if {[info exists idotherrefs($id)]} {
2818 set marks [concat $marks $idotherrefs($id)]
2824 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
2825 set yt [expr {$y1 - 0.5 * $linespc}]
2826 set yb [expr {$yt + $linespc - 1}]
2829 foreach tag $marks {
2830 set wid [font measure $mainfont $tag]
2833 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
2835 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
2836 -width $lthickness -fill black -tags tag.$id]
2838 foreach tag $marks x $xvals wid $wvals {
2839 set xl [expr {$x + $delta}]
2840 set xr [expr {$x + $delta + $wid + $lthickness}]
2841 if {[incr ntags -1] >= 0} {
2843 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
2844 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
2845 -width 1 -outline black -fill yellow -tags tag.$id]
2846 $canv bind $t <1> [list showtag $tag 1]
2847 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
2849 # draw a head or other ref
2850 if {[incr nheads -1] >= 0} {
2855 set xl [expr {$xl - $delta/2}]
2856 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
2857 -width 1 -outline black -fill $col -tags tag.$id
2858 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
2859 set rwid [font measure $mainfont $remoteprefix]
2860 set xi [expr {$x + 1}]
2861 set yti [expr {$yt + 1}]
2862 set xri [expr {$x + $rwid}]
2863 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
2864 -width 0 -fill "#ffddaa" -tags tag.$id
2867 set t [$canv create text $xl $y1 -anchor w -text $tag \
2868 -font $mainfont -tags tag.$id]
2870 $canv bind $t <1> [list showtag $tag 1]
2876 proc xcoord {i level ln} {
2877 global canvx0 xspc1 xspc2
2879 set x [expr {$canvx0 + $i * $xspc1($ln)}]
2880 if {$i > 0 && $i == $level} {
2881 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
2882 } elseif {$i > $level} {
2883 set x [expr {$x + $xspc2 - $xspc1($ln)}]
2888 proc show_status {msg} {
2889 global canv mainfont
2892 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
2895 proc finishcommits {} {
2896 global commitidx phase curview
2897 global canv mainfont ctext maincursor textcursor
2898 global findinprogress pending_select
2900 if {$commitidx($curview) > 0} {
2903 show_status "No commits selected"
2906 catch {unset pending_select}
2909 # Don't change the text pane cursor if it is currently the hand cursor,
2910 # showing that we are over a sha1 ID link.
2911 proc settextcursor {c} {
2912 global ctext curtextcursor
2914 if {[$ctext cget -cursor] == $curtextcursor} {
2915 $ctext config -cursor $c
2917 set curtextcursor $c
2920 proc nowbusy {what} {
2923 if {[array names isbusy] eq {}} {
2924 . config -cursor watch
2930 proc notbusy {what} {
2931 global isbusy maincursor textcursor
2933 catch {unset isbusy($what)}
2934 if {[array names isbusy] eq {}} {
2935 . config -cursor $maincursor
2936 settextcursor $textcursor
2943 global canvy0 numcommits linespc
2944 global rowlaidout commitidx curview
2945 global pending_select
2948 layoutrows $rowlaidout $commitidx($curview) 1
2950 optimize_rows $row 0 $commitidx($curview)
2951 showstuff $commitidx($curview)
2952 if {[info exists pending_select]} {
2956 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
2957 #puts "overall $drawmsecs ms for $numcommits commits"
2960 proc findmatches {f} {
2961 global findtype foundstring foundstrlen
2962 if {$findtype == "Regexp"} {
2963 set matches [regexp -indices -all -inline $foundstring $f]
2965 if {$findtype == "IgnCase"} {
2966 set str [string tolower $f]
2972 while {[set j [string first $foundstring $str $i]] >= 0} {
2973 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
2974 set i [expr {$j + $foundstrlen}]
2981 global findtype findloc findstring markedmatches commitinfo
2982 global numcommits displayorder linehtag linentag linedtag
2983 global mainfont canv canv2 canv3 selectedline
2984 global matchinglines foundstring foundstrlen matchstring
2990 set matchinglines {}
2991 if {$findloc == "Pickaxe"} {
2995 if {$findtype == "IgnCase"} {
2996 set foundstring [string tolower $findstring]
2998 set foundstring $findstring
3000 set foundstrlen [string length $findstring]
3001 if {$foundstrlen == 0} return
3002 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3003 set matchstring "*$matchstring*"
3004 if {$findloc == "Files"} {
3008 if {![info exists selectedline]} {
3011 set oldsel $selectedline
3014 set fldtypes {Headline Author Date Committer CDate Comment}
3016 foreach id $displayorder {
3017 set d $commitdata($id)
3019 if {$findtype == "Regexp"} {
3020 set doesmatch [regexp $foundstring $d]
3021 } elseif {$findtype == "IgnCase"} {
3022 set doesmatch [string match -nocase $matchstring $d]
3024 set doesmatch [string match $matchstring $d]
3026 if {!$doesmatch} continue
3027 if {![info exists commitinfo($id)]} {
3030 set info $commitinfo($id)
3032 foreach f $info ty $fldtypes {
3033 if {$findloc != "All fields" && $findloc != $ty} {
3036 set matches [findmatches $f]
3037 if {$matches == {}} continue
3039 if {$ty == "Headline"} {
3041 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3042 } elseif {$ty == "Author"} {
3044 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3045 } elseif {$ty == "Date"} {
3047 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3051 lappend matchinglines $l
3052 if {!$didsel && $l > $oldsel} {
3058 if {$matchinglines == {}} {
3060 } elseif {!$didsel} {
3061 findselectline [lindex $matchinglines 0]
3065 proc findselectline {l} {
3066 global findloc commentend ctext
3068 if {$findloc == "All fields" || $findloc == "Comments"} {
3069 # highlight the matches in the comments
3070 set f [$ctext get 1.0 $commentend]
3071 set matches [findmatches $f]
3072 foreach match $matches {
3073 set start [lindex $match 0]
3074 set end [expr {[lindex $match 1] + 1}]
3075 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3080 proc findnext {restart} {
3081 global matchinglines selectedline
3082 if {![info exists matchinglines]} {
3088 if {![info exists selectedline]} return
3089 foreach l $matchinglines {
3090 if {$l > $selectedline} {
3099 global matchinglines selectedline
3100 if {![info exists matchinglines]} {
3104 if {![info exists selectedline]} return
3106 foreach l $matchinglines {
3107 if {$l >= $selectedline} break
3111 findselectline $prev
3117 proc findlocchange {name ix op} {
3118 global findloc findtype findtypemenu
3119 if {$findloc == "Pickaxe"} {
3125 $findtypemenu entryconf 1 -state $state
3126 $findtypemenu entryconf 2 -state $state
3129 proc stopfindproc {{done 0}} {
3130 global findprocpid findprocfile findids
3131 global ctext findoldcursor phase maincursor textcursor
3132 global findinprogress
3134 catch {unset findids}
3135 if {[info exists findprocpid]} {
3137 catch {exec kill $findprocpid}
3139 catch {close $findprocfile}
3142 catch {unset findinprogress}
3146 proc findpatches {} {
3147 global findstring selectedline numcommits
3148 global findprocpid findprocfile
3149 global finddidsel ctext displayorder findinprogress
3150 global findinsertpos
3152 if {$numcommits == 0} return
3154 # make a list of all the ids to search, starting at the one
3155 # after the selected line (if any)
3156 if {[info exists selectedline]} {
3162 for {set i 0} {$i < $numcommits} {incr i} {
3163 if {[incr l] >= $numcommits} {
3166 append inputids [lindex $displayorder $l] "\n"
3170 set f [open [list | git-diff-tree --stdin -s -r -S$findstring \
3173 error_popup "Error starting search process: $err"
3177 set findinsertpos end
3179 set findprocpid [pid $f]
3180 fconfigure $f -blocking 0
3181 fileevent $f readable readfindproc
3184 set findinprogress 1
3187 proc readfindproc {} {
3188 global findprocfile finddidsel
3189 global commitrow matchinglines findinsertpos curview
3191 set n [gets $findprocfile line]
3193 if {[eof $findprocfile]} {
3201 if {![regexp {^[0-9a-f]{40}} $line id]} {
3202 error_popup "Can't parse git-diff-tree output: $line"
3206 if {![info exists commitrow($curview,$id)]} {
3207 puts stderr "spurious id: $id"
3210 set l $commitrow($curview,$id)
3214 proc insertmatch {l id} {
3215 global matchinglines findinsertpos finddidsel
3217 if {$findinsertpos == "end"} {
3218 if {$matchinglines != {} && $l < [lindex $matchinglines 0]} {
3219 set matchinglines [linsert $matchinglines 0 $l]
3222 lappend matchinglines $l
3225 set matchinglines [linsert $matchinglines $findinsertpos $l]
3236 global selectedline numcommits displayorder ctext
3237 global ffileline finddidsel parentlist
3238 global findinprogress findstartline findinsertpos
3239 global treediffs fdiffid fdiffsneeded fdiffpos
3240 global findmergefiles
3242 if {$numcommits == 0} return
3244 if {[info exists selectedline]} {
3245 set l [expr {$selectedline + 1}]
3250 set findstartline $l
3254 set id [lindex $displayorder $l]
3255 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3256 if {![info exists treediffs($id)]} {
3257 append diffsneeded "$id\n"
3258 lappend fdiffsneeded $id
3261 if {[incr l] >= $numcommits} {
3264 if {$l == $findstartline} break
3267 # start off a git-diff-tree process if needed
3268 if {$diffsneeded ne {}} {
3270 set df [open [list | git-diff-tree -r --stdin << $diffsneeded] r]
3272 error_popup "Error starting search process: $err"
3275 catch {unset fdiffid}
3277 fconfigure $df -blocking 0
3278 fileevent $df readable [list readfilediffs $df]
3282 set findinsertpos end
3283 set id [lindex $displayorder $l]
3285 set findinprogress 1
3290 proc readfilediffs {df} {
3291 global findid fdiffid fdiffs
3293 set n [gets $df line]
3297 if {[catch {close $df} err]} {
3300 error_popup "Error in git-diff-tree: $err"
3301 } elseif {[info exists findid]} {
3305 error_popup "Couldn't find diffs for $id"
3310 if {[regexp {^([0-9a-f]{40})$} $line match id]} {
3311 # start of a new string of diffs
3315 } elseif {[string match ":*" $line]} {
3316 lappend fdiffs [lindex $line 5]
3320 proc donefilediff {} {
3321 global fdiffid fdiffs treediffs findid
3322 global fdiffsneeded fdiffpos
3324 if {[info exists fdiffid]} {
3325 while {[lindex $fdiffsneeded $fdiffpos] ne $fdiffid
3326 && $fdiffpos < [llength $fdiffsneeded]} {
3327 # git-diff-tree doesn't output anything for a commit
3328 # which doesn't change anything
3329 set nullid [lindex $fdiffsneeded $fdiffpos]
3330 set treediffs($nullid) {}
3331 if {[info exists findid] && $nullid eq $findid} {
3339 if {![info exists treediffs($fdiffid)]} {
3340 set treediffs($fdiffid) $fdiffs
3342 if {[info exists findid] && $fdiffid eq $findid} {
3350 global findid treediffs parentlist
3351 global ffileline findstartline finddidsel
3352 global displayorder numcommits matchinglines findinprogress
3353 global findmergefiles
3357 set id [lindex $displayorder $l]
3358 if {$findmergefiles || [llength [lindex $parentlist $l]] == 1} {
3359 if {![info exists treediffs($id)]} {
3365 foreach f $treediffs($id) {
3366 set x [findmatches $f]
3376 if {[incr l] >= $numcommits} {
3379 if {$l == $findstartline} break
3387 # mark a commit as matching by putting a yellow background
3388 # behind the headline
3389 proc markheadline {l id} {
3390 global canv mainfont linehtag
3393 set bbox [$canv bbox $linehtag($l)]
3394 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3398 # mark the bits of a headline, author or date that match a find string
3399 proc markmatches {canv l str tag matches font} {
3400 set bbox [$canv bbox $tag]
3401 set x0 [lindex $bbox 0]
3402 set y0 [lindex $bbox 1]
3403 set y1 [lindex $bbox 3]
3404 foreach match $matches {
3405 set start [lindex $match 0]
3406 set end [lindex $match 1]
3407 if {$start > $end} continue
3408 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3409 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3410 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3411 [expr {$x0+$xlen+2}] $y1 \
3412 -outline {} -tags matches -fill yellow]
3417 proc unmarkmatches {} {
3418 global matchinglines findids
3419 allcanvs delete matches
3420 catch {unset matchinglines}
3421 catch {unset findids}
3424 proc selcanvline {w x y} {
3425 global canv canvy0 ctext linespc
3427 set ymax [lindex [$canv cget -scrollregion] 3]
3428 if {$ymax == {}} return
3429 set yfrac [lindex [$canv yview] 0]
3430 set y [expr {$y + $yfrac * $ymax}]
3431 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3436 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3442 proc commit_descriptor {p} {
3444 if {![info exists commitinfo($p)]} {
3448 if {[llength $commitinfo($p)] > 1} {
3449 set l [lindex $commitinfo($p) 0]
3454 # append some text to the ctext widget, and make any SHA1 ID
3455 # that we know about be a clickable link.
3456 proc appendwithlinks {text} {
3457 global ctext commitrow linknum curview
3459 set start [$ctext index "end - 1c"]
3460 $ctext insert end $text
3461 $ctext insert end "\n"
3462 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3466 set linkid [string range $text $s $e]
3467 if {![info exists commitrow($curview,$linkid)]} continue
3469 $ctext tag add link "$start + $s c" "$start + $e c"
3470 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3471 $ctext tag bind link$linknum <1> \
3472 [list selectline $commitrow($curview,$linkid) 1]
3475 $ctext tag conf link -foreground blue -underline 1
3476 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3477 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3480 proc viewnextline {dir} {
3484 set ymax [lindex [$canv cget -scrollregion] 3]
3485 set wnow [$canv yview]
3486 set wtop [expr {[lindex $wnow 0] * $ymax}]
3487 set newtop [expr {$wtop + $dir * $linespc}]
3490 } elseif {$newtop > $ymax} {
3493 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3496 proc selectline {l isnew} {
3497 global canv canv2 canv3 ctext commitinfo selectedline
3498 global displayorder linehtag linentag linedtag
3499 global canvy0 linespc parentlist childlist
3500 global currentid sha1entry
3501 global commentend idtags linknum
3502 global mergemax numcommits pending_select
3505 catch {unset pending_select}
3508 if {$l < 0 || $l >= $numcommits} return
3509 set y [expr {$canvy0 + $l * $linespc}]
3510 set ymax [lindex [$canv cget -scrollregion] 3]
3511 set ytop [expr {$y - $linespc - 1}]
3512 set ybot [expr {$y + $linespc + 1}]
3513 set wnow [$canv yview]
3514 set wtop [expr {[lindex $wnow 0] * $ymax}]
3515 set wbot [expr {[lindex $wnow 1] * $ymax}]
3516 set wh [expr {$wbot - $wtop}]
3518 if {$ytop < $wtop} {
3519 if {$ybot < $wtop} {
3520 set newtop [expr {$y - $wh / 2.0}]
3523 if {$newtop > $wtop - $linespc} {
3524 set newtop [expr {$wtop - $linespc}]
3527 } elseif {$ybot > $wbot} {
3528 if {$ytop > $wbot} {
3529 set newtop [expr {$y - $wh / 2.0}]
3531 set newtop [expr {$ybot - $wh}]
3532 if {$newtop < $wtop + $linespc} {
3533 set newtop [expr {$wtop + $linespc}]
3537 if {$newtop != $wtop} {
3541 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3545 if {![info exists linehtag($l)]} return
3547 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3548 -tags secsel -fill [$canv cget -selectbackground]]
3550 $canv2 delete secsel
3551 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3552 -tags secsel -fill [$canv2 cget -selectbackground]]
3554 $canv3 delete secsel
3555 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3556 -tags secsel -fill [$canv3 cget -selectbackground]]
3560 addtohistory [list selectline $l 0]
3565 set id [lindex $displayorder $l]
3567 $sha1entry delete 0 end
3568 $sha1entry insert 0 $id
3569 $sha1entry selection from 0
3570 $sha1entry selection to end
3572 $ctext conf -state normal
3573 $ctext delete 0.0 end
3575 set info $commitinfo($id)
3576 set date [formatdate [lindex $info 2]]
3577 $ctext insert end "Author: [lindex $info 1] $date\n"
3578 set date [formatdate [lindex $info 4]]
3579 $ctext insert end "Committer: [lindex $info 3] $date\n"
3580 if {[info exists idtags($id)]} {
3581 $ctext insert end "Tags:"
3582 foreach tag $idtags($id) {
3583 $ctext insert end " $tag"
3585 $ctext insert end "\n"
3589 set olds [lindex $parentlist $l]
3590 if {[llength $olds] > 1} {
3593 if {$np >= $mergemax} {
3598 $ctext insert end "Parent: " $tag
3599 appendwithlinks [commit_descriptor $p]
3604 append comment "Parent: [commit_descriptor $p]\n"
3608 foreach c [lindex $childlist $l] {
3609 append comment "Child: [commit_descriptor $c]\n"
3612 append comment [lindex $info 5]
3614 # make anything that looks like a SHA1 ID be a clickable link
3615 appendwithlinks $comment
3617 $ctext tag delete Comments
3618 $ctext tag remove found 1.0 end
3619 $ctext conf -state disabled
3620 set commentend [$ctext index "end - 1c"]
3622 init_flist "Comments"
3623 if {$cmitmode eq "tree"} {
3625 } elseif {[llength $olds] <= 1} {
3632 proc selfirstline {} {
3637 proc sellastline {} {
3640 set l [expr {$numcommits - 1}]
3644 proc selnextline {dir} {
3646 if {![info exists selectedline]} return
3647 set l [expr {$selectedline + $dir}]
3652 proc selnextpage {dir} {
3653 global canv linespc selectedline numcommits
3655 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3659 allcanvs yview scroll [expr {$dir * $lpp}] units
3661 if {![info exists selectedline]} return
3662 set l [expr {$selectedline + $dir * $lpp}]
3665 } elseif {$l >= $numcommits} {
3666 set l [expr $numcommits - 1]
3672 proc unselectline {} {
3673 global selectedline currentid
3675 catch {unset selectedline}
3676 catch {unset currentid}
3677 allcanvs delete secsel
3680 proc reselectline {} {
3683 if {[info exists selectedline]} {
3684 selectline $selectedline 0
3688 proc addtohistory {cmd} {
3689 global history historyindex curview
3691 set elt [list $curview $cmd]
3692 if {$historyindex > 0
3693 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3697 if {$historyindex < [llength $history]} {
3698 set history [lreplace $history $historyindex end $elt]
3700 lappend history $elt
3703 if {$historyindex > 1} {
3704 .ctop.top.bar.leftbut conf -state normal
3706 .ctop.top.bar.leftbut conf -state disabled
3708 .ctop.top.bar.rightbut conf -state disabled
3714 set view [lindex $elt 0]
3715 set cmd [lindex $elt 1]
3716 if {$curview != $view} {
3723 global history historyindex
3725 if {$historyindex > 1} {
3726 incr historyindex -1
3727 godo [lindex $history [expr {$historyindex - 1}]]
3728 .ctop.top.bar.rightbut conf -state normal
3730 if {$historyindex <= 1} {
3731 .ctop.top.bar.leftbut conf -state disabled
3736 global history historyindex
3738 if {$historyindex < [llength $history]} {
3739 set cmd [lindex $history $historyindex]
3742 .ctop.top.bar.leftbut conf -state normal
3744 if {$historyindex >= [llength $history]} {
3745 .ctop.top.bar.rightbut conf -state disabled
3750 global treefilelist treeidlist diffids diffmergeid treepending
3753 catch {unset diffmergeid}
3754 if {![info exists treefilelist($id)]} {
3755 if {![info exists treepending]} {
3756 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3760 set treefilelist($id) {}
3761 set treeidlist($id) {}
3762 fconfigure $gtf -blocking 0
3763 fileevent $gtf readable [list gettreeline $gtf $id]
3770 proc gettreeline {gtf id} {
3771 global treefilelist treeidlist treepending cmitmode diffids
3773 while {[gets $gtf line] >= 0} {
3774 if {[lindex $line 1] ne "blob"} continue
3775 set sha1 [lindex $line 2]
3776 set fname [lindex $line 3]
3777 lappend treefilelist($id) $fname
3778 lappend treeidlist($id) $sha1
3780 if {![eof $gtf]} return
3783 if {$cmitmode ne "tree"} {
3784 if {![info exists diffmergeid]} {
3785 gettreediffs $diffids
3787 } elseif {$id ne $diffids} {
3795 global treefilelist treeidlist diffids
3796 global ctext commentend
3798 set i [lsearch -exact $treefilelist($diffids) $f]
3800 puts "oops, $f not in list for id $diffids"
3803 set blob [lindex $treeidlist($diffids) $i]
3804 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3805 puts "oops, error reading blob $blob: $err"
3808 fconfigure $bf -blocking 0
3809 fileevent $bf readable [list getblobline $bf $diffids]
3810 $ctext config -state normal
3811 $ctext delete $commentend end
3812 $ctext insert end "\n"
3813 $ctext insert end "$f\n" filesep
3814 $ctext config -state disabled
3815 $ctext yview $commentend
3818 proc getblobline {bf id} {
3819 global diffids cmitmode ctext
3821 if {$id ne $diffids || $cmitmode ne "tree"} {
3825 $ctext config -state normal
3826 while {[gets $bf line] >= 0} {
3827 $ctext insert end "$line\n"
3830 # delete last newline
3831 $ctext delete "end - 2c" "end - 1c"
3834 $ctext config -state disabled
3837 proc mergediff {id l} {
3838 global diffmergeid diffopts mdifffd
3844 # this doesn't seem to actually affect anything...
3845 set env(GIT_DIFF_OPTS) $diffopts
3846 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3847 if {[catch {set mdf [open $cmd r]} err]} {
3848 error_popup "Error getting merge diffs: $err"
3851 fconfigure $mdf -blocking 0
3852 set mdifffd($id) $mdf
3853 set np [llength [lindex $parentlist $l]]
3854 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3855 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3858 proc getmergediffline {mdf id np} {
3859 global diffmergeid ctext cflist nextupdate mergemax
3860 global difffilestart mdifffd
3862 set n [gets $mdf line]
3869 if {![info exists diffmergeid] || $id != $diffmergeid
3870 || $mdf != $mdifffd($id)} {
3873 $ctext conf -state normal
3874 if {[regexp {^diff --cc (.*)} $line match fname]} {
3875 # start of a new file
3876 $ctext insert end "\n"
3877 set here [$ctext index "end - 1c"]
3878 lappend difffilestart $here
3879 add_flist [list $fname]
3880 set l [expr {(78 - [string length $fname]) / 2}]
3881 set pad [string range "----------------------------------------" 1 $l]
3882 $ctext insert end "$pad $fname $pad\n" filesep
3883 } elseif {[regexp {^@@} $line]} {
3884 $ctext insert end "$line\n" hunksep
3885 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3888 # parse the prefix - one ' ', '-' or '+' for each parent
3893 for {set j 0} {$j < $np} {incr j} {
3894 set c [string range $line $j $j]
3897 } elseif {$c == "-"} {
3899 } elseif {$c == "+"} {
3908 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3909 # line doesn't appear in result, parents in $minuses have the line
3910 set num [lindex $minuses 0]
3911 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3912 # line appears in result, parents in $pluses don't have the line
3913 lappend tags mresult
3914 set num [lindex $spaces 0]
3917 if {$num >= $mergemax} {
3922 $ctext insert end "$line\n" $tags
3924 $ctext conf -state disabled
3925 if {[clock clicks -milliseconds] >= $nextupdate} {
3927 fileevent $mdf readable {}
3929 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3933 proc startdiff {ids} {
3934 global treediffs diffids treepending diffmergeid
3937 catch {unset diffmergeid}
3938 if {![info exists treediffs($ids)]} {
3939 if {![info exists treepending]} {
3947 proc addtocflist {ids} {
3948 global treediffs cflist
3949 add_flist $treediffs($ids)
3953 proc gettreediffs {ids} {
3954 global treediff treepending
3955 set treepending $ids
3958 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3960 fconfigure $gdtf -blocking 0
3961 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3964 proc gettreediffline {gdtf ids} {
3965 global treediff treediffs treepending diffids diffmergeid
3968 set n [gets $gdtf line]
3970 if {![eof $gdtf]} return
3972 set treediffs($ids) $treediff
3974 if {$cmitmode eq "tree"} {
3976 } elseif {$ids != $diffids} {
3977 if {![info exists diffmergeid]} {
3978 gettreediffs $diffids
3985 set file [lindex $line 5]
3986 lappend treediff $file
3989 proc getblobdiffs {ids} {
3990 global diffopts blobdifffd diffids env curdifftag curtagstart
3991 global nextupdate diffinhdr treediffs
3993 set env(GIT_DIFF_OPTS) $diffopts
3994 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3995 if {[catch {set bdf [open $cmd r]} err]} {
3996 puts "error getting diffs: $err"
4000 fconfigure $bdf -blocking 0
4001 set blobdifffd($ids) $bdf
4002 set curdifftag Comments
4004 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4005 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4008 proc setinlist {var i val} {
4011 while {[llength [set $var]] < $i} {
4014 if {[llength [set $var]] == $i} {
4021 proc getblobdiffline {bdf ids} {
4022 global diffids blobdifffd ctext curdifftag curtagstart
4023 global diffnexthead diffnextnote difffilestart
4024 global nextupdate diffinhdr treediffs
4026 set n [gets $bdf line]
4030 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4031 $ctext tag add $curdifftag $curtagstart end
4036 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4039 $ctext conf -state normal
4040 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4041 # start of a new file
4042 $ctext insert end "\n"
4043 $ctext tag add $curdifftag $curtagstart end
4044 set here [$ctext index "end - 1c"]
4045 set curtagstart $here
4047 set i [lsearch -exact $treediffs($ids) $fname]
4049 setinlist difffilestart $i $here
4051 if {$newname ne $fname} {
4052 set i [lsearch -exact $treediffs($ids) $newname]
4054 setinlist difffilestart $i $here
4057 set curdifftag "f:$fname"
4058 $ctext tag delete $curdifftag
4059 set l [expr {(78 - [string length $header]) / 2}]
4060 set pad [string range "----------------------------------------" 1 $l]
4061 $ctext insert end "$pad $header $pad\n" filesep
4063 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4065 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4067 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4068 $line match f1l f1c f2l f2c rest]} {
4069 $ctext insert end "$line\n" hunksep
4072 set x [string range $line 0 0]
4073 if {$x == "-" || $x == "+"} {
4074 set tag [expr {$x == "+"}]
4075 $ctext insert end "$line\n" d$tag
4076 } elseif {$x == " "} {
4077 $ctext insert end "$line\n"
4078 } elseif {$diffinhdr || $x == "\\"} {
4079 # e.g. "\ No newline at end of file"
4080 $ctext insert end "$line\n" filesep
4082 # Something else we don't recognize
4083 if {$curdifftag != "Comments"} {
4084 $ctext insert end "\n"
4085 $ctext tag add $curdifftag $curtagstart end
4086 set curtagstart [$ctext index "end - 1c"]
4087 set curdifftag Comments
4089 $ctext insert end "$line\n" filesep
4092 $ctext conf -state disabled
4093 if {[clock clicks -milliseconds] >= $nextupdate} {
4095 fileevent $bdf readable {}
4097 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4102 global difffilestart ctext
4103 set here [$ctext index @0,0]
4104 foreach loc $difffilestart {
4105 if {[$ctext compare $loc > $here]} {
4112 global linespc charspc canvx0 canvy0 mainfont
4113 global xspc1 xspc2 lthickness
4115 set linespc [font metrics $mainfont -linespace]
4116 set charspc [font measure $mainfont "m"]
4117 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4118 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4119 set lthickness [expr {int($linespc / 9) + 1}]
4120 set xspc1(0) $linespc
4128 set ymax [lindex [$canv cget -scrollregion] 3]
4129 if {$ymax eq {} || $ymax == 0} return
4130 set span [$canv yview]
4133 allcanvs yview moveto [lindex $span 0]
4135 if {[info exists selectedline]} {
4136 selectline $selectedline 0
4140 proc incrfont {inc} {
4141 global mainfont textfont ctext canv phase
4142 global stopped entries
4144 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4145 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4147 $ctext conf -font $textfont
4148 $ctext tag conf filesep -font [concat $textfont bold]
4149 foreach e $entries {
4150 $e conf -font $mainfont
4152 if {$phase eq "getcommits"} {
4153 $canv itemconf textitems -font $mainfont
4159 global sha1entry sha1string
4160 if {[string length $sha1string] == 40} {
4161 $sha1entry delete 0 end
4165 proc sha1change {n1 n2 op} {
4166 global sha1string currentid sha1but
4167 if {$sha1string == {}
4168 || ([info exists currentid] && $sha1string == $currentid)} {
4173 if {[$sha1but cget -state] == $state} return
4174 if {$state == "normal"} {
4175 $sha1but conf -state normal -relief raised -text "Goto: "
4177 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4181 proc gotocommit {} {
4182 global sha1string currentid commitrow tagids headids
4183 global displayorder numcommits curview
4185 if {$sha1string == {}
4186 || ([info exists currentid] && $sha1string == $currentid)} return
4187 if {[info exists tagids($sha1string)]} {
4188 set id $tagids($sha1string)
4189 } elseif {[info exists headids($sha1string)]} {
4190 set id $headids($sha1string)
4192 set id [string tolower $sha1string]
4193 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4195 foreach i $displayorder {
4196 if {[string match $id* $i]} {
4200 if {$matches ne {}} {
4201 if {[llength $matches] > 1} {
4202 error_popup "Short SHA1 id $id is ambiguous"
4205 set id [lindex $matches 0]
4209 if {[info exists commitrow($curview,$id)]} {
4210 selectline $commitrow($curview,$id) 1
4213 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4218 error_popup "$type $sha1string is not known"
4221 proc lineenter {x y id} {
4222 global hoverx hovery hoverid hovertimer
4223 global commitinfo canv
4225 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4229 if {[info exists hovertimer]} {
4230 after cancel $hovertimer
4232 set hovertimer [after 500 linehover]
4236 proc linemotion {x y id} {
4237 global hoverx hovery hoverid hovertimer
4239 if {[info exists hoverid] && $id == $hoverid} {
4242 if {[info exists hovertimer]} {
4243 after cancel $hovertimer
4245 set hovertimer [after 500 linehover]
4249 proc lineleave {id} {
4250 global hoverid hovertimer canv
4252 if {[info exists hoverid] && $id == $hoverid} {
4254 if {[info exists hovertimer]} {
4255 after cancel $hovertimer
4263 global hoverx hovery hoverid hovertimer
4264 global canv linespc lthickness
4265 global commitinfo mainfont
4267 set text [lindex $commitinfo($hoverid) 0]
4268 set ymax [lindex [$canv cget -scrollregion] 3]
4269 if {$ymax == {}} return
4270 set yfrac [lindex [$canv yview] 0]
4271 set x [expr {$hoverx + 2 * $linespc}]
4272 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4273 set x0 [expr {$x - 2 * $lthickness}]
4274 set y0 [expr {$y - 2 * $lthickness}]
4275 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4276 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4277 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4278 -fill \#ffff80 -outline black -width 1 -tags hover]
4280 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4284 proc clickisonarrow {id y} {
4287 set ranges [rowranges $id]
4288 set thresh [expr {2 * $lthickness + 6}]
4289 set n [expr {[llength $ranges] - 1}]
4290 for {set i 1} {$i < $n} {incr i} {
4291 set row [lindex $ranges $i]
4292 if {abs([yc $row] - $y) < $thresh} {
4299 proc arrowjump {id n y} {
4302 # 1 <-> 2, 3 <-> 4, etc...
4303 set n [expr {(($n - 1) ^ 1) + 1}]
4304 set row [lindex [rowranges $id] $n]
4306 set ymax [lindex [$canv cget -scrollregion] 3]
4307 if {$ymax eq {} || $ymax <= 0} return
4308 set view [$canv yview]
4309 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4310 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4314 allcanvs yview moveto $yfrac
4317 proc lineclick {x y id isnew} {
4318 global ctext commitinfo children canv thickerline curview
4320 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4325 # draw this line thicker than normal
4329 set ymax [lindex [$canv cget -scrollregion] 3]
4330 if {$ymax eq {}} return
4331 set yfrac [lindex [$canv yview] 0]
4332 set y [expr {$y + $yfrac * $ymax}]
4334 set dirn [clickisonarrow $id $y]
4336 arrowjump $id $dirn $y
4341 addtohistory [list lineclick $x $y $id 0]
4343 # fill the details pane with info about this line
4344 $ctext conf -state normal
4345 $ctext delete 0.0 end
4346 $ctext tag conf link -foreground blue -underline 1
4347 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4348 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4349 $ctext insert end "Parent:\t"
4350 $ctext insert end $id [list link link0]
4351 $ctext tag bind link0 <1> [list selbyid $id]
4352 set info $commitinfo($id)
4353 $ctext insert end "\n\t[lindex $info 0]\n"
4354 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4355 set date [formatdate [lindex $info 2]]
4356 $ctext insert end "\tDate:\t$date\n"
4357 set kids $children($curview,$id)
4359 $ctext insert end "\nChildren:"
4361 foreach child $kids {
4363 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4364 set info $commitinfo($child)
4365 $ctext insert end "\n\t"
4366 $ctext insert end $child [list link link$i]
4367 $ctext tag bind link$i <1> [list selbyid $child]
4368 $ctext insert end "\n\t[lindex $info 0]"
4369 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4370 set date [formatdate [lindex $info 2]]
4371 $ctext insert end "\n\tDate:\t$date\n"
4374 $ctext conf -state disabled
4378 proc normalline {} {
4380 if {[info exists thickerline]} {
4388 global commitrow curview
4389 if {[info exists commitrow($curview,$id)]} {
4390 selectline $commitrow($curview,$id) 1
4396 if {![info exists startmstime]} {
4397 set startmstime [clock clicks -milliseconds]
4399 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4402 proc rowmenu {x y id} {
4403 global rowctxmenu commitrow selectedline rowmenuid curview
4405 if {![info exists selectedline]
4406 || $commitrow($curview,$id) eq $selectedline} {
4411 $rowctxmenu entryconfigure 0 -state $state
4412 $rowctxmenu entryconfigure 1 -state $state
4413 $rowctxmenu entryconfigure 2 -state $state
4415 tk_popup $rowctxmenu $x $y
4418 proc diffvssel {dirn} {
4419 global rowmenuid selectedline displayorder
4421 if {![info exists selectedline]} return
4423 set oldid [lindex $displayorder $selectedline]
4424 set newid $rowmenuid
4426 set oldid $rowmenuid
4427 set newid [lindex $displayorder $selectedline]
4429 addtohistory [list doseldiff $oldid $newid]
4430 doseldiff $oldid $newid
4433 proc doseldiff {oldid newid} {
4437 $ctext conf -state normal
4438 $ctext delete 0.0 end
4440 $ctext insert end "From "
4441 $ctext tag conf link -foreground blue -underline 1
4442 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4443 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4444 $ctext tag bind link0 <1> [list selbyid $oldid]
4445 $ctext insert end $oldid [list link link0]
4446 $ctext insert end "\n "
4447 $ctext insert end [lindex $commitinfo($oldid) 0]
4448 $ctext insert end "\n\nTo "
4449 $ctext tag bind link1 <1> [list selbyid $newid]
4450 $ctext insert end $newid [list link link1]
4451 $ctext insert end "\n "
4452 $ctext insert end [lindex $commitinfo($newid) 0]
4453 $ctext insert end "\n"
4454 $ctext conf -state disabled
4455 $ctext tag delete Comments
4456 $ctext tag remove found 1.0 end
4457 startdiff [list $oldid $newid]
4461 global rowmenuid currentid commitinfo patchtop patchnum
4463 if {![info exists currentid]} return
4464 set oldid $currentid
4465 set oldhead [lindex $commitinfo($oldid) 0]
4466 set newid $rowmenuid
4467 set newhead [lindex $commitinfo($newid) 0]
4470 catch {destroy $top}
4472 label $top.title -text "Generate patch"
4473 grid $top.title - -pady 10
4474 label $top.from -text "From:"
4475 entry $top.fromsha1 -width 40 -relief flat
4476 $top.fromsha1 insert 0 $oldid
4477 $top.fromsha1 conf -state readonly
4478 grid $top.from $top.fromsha1 -sticky w
4479 entry $top.fromhead -width 60 -relief flat
4480 $top.fromhead insert 0 $oldhead
4481 $top.fromhead conf -state readonly
4482 grid x $top.fromhead -sticky w
4483 label $top.to -text "To:"
4484 entry $top.tosha1 -width 40 -relief flat
4485 $top.tosha1 insert 0 $newid
4486 $top.tosha1 conf -state readonly
4487 grid $top.to $top.tosha1 -sticky w
4488 entry $top.tohead -width 60 -relief flat
4489 $top.tohead insert 0 $newhead
4490 $top.tohead conf -state readonly
4491 grid x $top.tohead -sticky w
4492 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4493 grid $top.rev x -pady 10
4494 label $top.flab -text "Output file:"
4495 entry $top.fname -width 60
4496 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4498 grid $top.flab $top.fname -sticky w
4500 button $top.buts.gen -text "Generate" -command mkpatchgo
4501 button $top.buts.can -text "Cancel" -command mkpatchcan
4502 grid $top.buts.gen $top.buts.can
4503 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4504 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4505 grid $top.buts - -pady 10 -sticky ew
4509 proc mkpatchrev {} {
4512 set oldid [$patchtop.fromsha1 get]
4513 set oldhead [$patchtop.fromhead get]
4514 set newid [$patchtop.tosha1 get]
4515 set newhead [$patchtop.tohead get]
4516 foreach e [list fromsha1 fromhead tosha1 tohead] \
4517 v [list $newid $newhead $oldid $oldhead] {
4518 $patchtop.$e conf -state normal
4519 $patchtop.$e delete 0 end
4520 $patchtop.$e insert 0 $v
4521 $patchtop.$e conf -state readonly
4528 set oldid [$patchtop.fromsha1 get]
4529 set newid [$patchtop.tosha1 get]
4530 set fname [$patchtop.fname get]
4531 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4532 error_popup "Error creating patch: $err"
4534 catch {destroy $patchtop}
4538 proc mkpatchcan {} {
4541 catch {destroy $patchtop}
4546 global rowmenuid mktagtop commitinfo
4550 catch {destroy $top}
4552 label $top.title -text "Create tag"
4553 grid $top.title - -pady 10
4554 label $top.id -text "ID:"
4555 entry $top.sha1 -width 40 -relief flat
4556 $top.sha1 insert 0 $rowmenuid
4557 $top.sha1 conf -state readonly
4558 grid $top.id $top.sha1 -sticky w
4559 entry $top.head -width 60 -relief flat
4560 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4561 $top.head conf -state readonly
4562 grid x $top.head -sticky w
4563 label $top.tlab -text "Tag name:"
4564 entry $top.tag -width 60
4565 grid $top.tlab $top.tag -sticky w
4567 button $top.buts.gen -text "Create" -command mktaggo
4568 button $top.buts.can -text "Cancel" -command mktagcan
4569 grid $top.buts.gen $top.buts.can
4570 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4571 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4572 grid $top.buts - -pady 10 -sticky ew
4577 global mktagtop env tagids idtags
4579 set id [$mktagtop.sha1 get]
4580 set tag [$mktagtop.tag get]
4582 error_popup "No tag name specified"
4585 if {[info exists tagids($tag)]} {
4586 error_popup "Tag \"$tag\" already exists"
4591 set fname [file join $dir "refs/tags" $tag]
4592 set f [open $fname w]
4596 error_popup "Error creating tag: $err"
4600 set tagids($tag) $id
4601 lappend idtags($id) $tag
4605 proc redrawtags {id} {
4606 global canv linehtag commitrow idpos selectedline curview
4608 if {![info exists commitrow($curview,$id)]} return
4609 drawcmitrow $commitrow($curview,$id)
4610 $canv delete tag.$id
4611 set xt [eval drawtags $id $idpos($id)]
4612 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4613 if {[info exists selectedline]
4614 && $selectedline == $commitrow($curview,$id)} {
4615 selectline $selectedline 0
4622 catch {destroy $mktagtop}
4631 proc writecommit {} {
4632 global rowmenuid wrcomtop commitinfo wrcomcmd
4634 set top .writecommit
4636 catch {destroy $top}
4638 label $top.title -text "Write commit to file"
4639 grid $top.title - -pady 10
4640 label $top.id -text "ID:"
4641 entry $top.sha1 -width 40 -relief flat
4642 $top.sha1 insert 0 $rowmenuid
4643 $top.sha1 conf -state readonly
4644 grid $top.id $top.sha1 -sticky w
4645 entry $top.head -width 60 -relief flat
4646 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4647 $top.head conf -state readonly
4648 grid x $top.head -sticky w
4649 label $top.clab -text "Command:"
4650 entry $top.cmd -width 60 -textvariable wrcomcmd
4651 grid $top.clab $top.cmd -sticky w -pady 10
4652 label $top.flab -text "Output file:"
4653 entry $top.fname -width 60
4654 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4655 grid $top.flab $top.fname -sticky w
4657 button $top.buts.gen -text "Write" -command wrcomgo
4658 button $top.buts.can -text "Cancel" -command wrcomcan
4659 grid $top.buts.gen $top.buts.can
4660 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4661 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4662 grid $top.buts - -pady 10 -sticky ew
4669 set id [$wrcomtop.sha1 get]
4670 set cmd "echo $id | [$wrcomtop.cmd get]"
4671 set fname [$wrcomtop.fname get]
4672 if {[catch {exec sh -c $cmd >$fname &} err]} {
4673 error_popup "Error writing commit: $err"
4675 catch {destroy $wrcomtop}
4682 catch {destroy $wrcomtop}
4686 proc listrefs {id} {
4687 global idtags idheads idotherrefs
4690 if {[info exists idtags($id)]} {
4694 if {[info exists idheads($id)]} {
4698 if {[info exists idotherrefs($id)]} {
4699 set z $idotherrefs($id)
4701 return [list $x $y $z]
4704 proc rereadrefs {} {
4705 global idtags idheads idotherrefs
4707 set refids [concat [array names idtags] \
4708 [array names idheads] [array names idotherrefs]]
4709 foreach id $refids {
4710 if {![info exists ref($id)]} {
4711 set ref($id) [listrefs $id]
4715 set refids [lsort -unique [concat $refids [array names idtags] \
4716 [array names idheads] [array names idotherrefs]]]
4717 foreach id $refids {
4718 set v [listrefs $id]
4719 if {![info exists ref($id)] || $ref($id) != $v} {
4725 proc showtag {tag isnew} {
4726 global ctext tagcontents tagids linknum
4729 addtohistory [list showtag $tag 0]
4731 $ctext conf -state normal
4732 $ctext delete 0.0 end
4734 if {[info exists tagcontents($tag)]} {
4735 set text $tagcontents($tag)
4737 set text "Tag: $tag\nId: $tagids($tag)"
4739 appendwithlinks $text
4740 $ctext conf -state disabled
4751 global maxwidth maxgraphpct diffopts findmergefiles
4752 global oldprefs prefstop
4756 if {[winfo exists $top]} {
4760 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4761 set oldprefs($v) [set $v]
4764 wm title $top "Gitk preferences"
4765 label $top.ldisp -text "Commit list display options"
4766 grid $top.ldisp - -sticky w -pady 10
4767 label $top.spacer -text " "
4768 label $top.maxwidthl -text "Maximum graph width (lines)" \
4770 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4771 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4772 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4774 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4775 grid x $top.maxpctl $top.maxpct -sticky w
4776 checkbutton $top.findm -variable findmergefiles
4777 label $top.findml -text "Include merges for \"Find\" in \"Files\"" \
4779 grid $top.findm $top.findml - -sticky w
4780 label $top.ddisp -text "Diff display options"
4781 grid $top.ddisp - -sticky w -pady 10
4782 label $top.diffoptl -text "Options for diff program" \
4784 entry $top.diffopt -width 20 -textvariable diffopts
4785 grid x $top.diffoptl $top.diffopt -sticky w
4787 button $top.buts.ok -text "OK" -command prefsok
4788 button $top.buts.can -text "Cancel" -command prefscan
4789 grid $top.buts.ok $top.buts.can
4790 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4791 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4792 grid $top.buts - - -pady 10 -sticky ew
4796 global maxwidth maxgraphpct diffopts findmergefiles
4797 global oldprefs prefstop
4799 foreach v {maxwidth maxgraphpct diffopts findmergefiles} {
4800 set $v $oldprefs($v)
4802 catch {destroy $prefstop}
4807 global maxwidth maxgraphpct
4808 global oldprefs prefstop
4810 catch {destroy $prefstop}
4812 if {$maxwidth != $oldprefs(maxwidth)
4813 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4818 proc formatdate {d} {
4819 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4822 # This list of encoding names and aliases is distilled from
4823 # http://www.iana.org/assignments/character-sets.
4824 # Not all of them are supported by Tcl.
4825 set encoding_aliases {
4826 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4827 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4828 { ISO-10646-UTF-1 csISO10646UTF1 }
4829 { ISO_646.basic:1983 ref csISO646basic1983 }
4830 { INVARIANT csINVARIANT }
4831 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4832 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4833 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4834 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4835 { NATS-DANO iso-ir-9-1 csNATSDANO }
4836 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4837 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4838 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4839 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4840 { ISO-2022-KR csISO2022KR }
4842 { ISO-2022-JP csISO2022JP }
4843 { ISO-2022-JP-2 csISO2022JP2 }
4844 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4846 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4847 { IT iso-ir-15 ISO646-IT csISO15Italian }
4848 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4849 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4850 { greek7-old iso-ir-18 csISO18Greek7Old }
4851 { latin-greek iso-ir-19 csISO19LatinGreek }
4852 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4853 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4854 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4855 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4856 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4857 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4858 { INIS iso-ir-49 csISO49INIS }
4859 { INIS-8 iso-ir-50 csISO50INIS8 }
4860 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4861 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4862 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4863 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4864 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4865 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4867 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4868 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4869 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4870 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4871 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4872 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4873 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4874 { greek7 iso-ir-88 csISO88Greek7 }
4875 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4876 { iso-ir-90 csISO90 }
4877 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4878 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4879 csISO92JISC62991984b }
4880 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4881 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4882 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4883 csISO95JIS62291984handadd }
4884 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
4885 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
4886 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
4887 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
4889 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
4890 { T.61-7bit iso-ir-102 csISO102T617bit }
4891 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
4892 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
4893 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
4894 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
4895 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
4896 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
4897 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
4898 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
4899 arabic csISOLatinArabic }
4900 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
4901 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
4902 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
4903 greek greek8 csISOLatinGreek }
4904 { T.101-G2 iso-ir-128 csISO128T101G2 }
4905 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
4907 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
4908 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
4909 { CSN_369103 iso-ir-139 csISO139CSN369103 }
4910 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
4911 { ISO_6937-2-add iso-ir-142 csISOTextComm }
4912 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
4913 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
4914 csISOLatinCyrillic }
4915 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
4916 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
4917 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
4918 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
4919 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
4920 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
4921 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
4922 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
4923 { ISO_10367-box iso-ir-155 csISO10367Box }
4924 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
4925 { latin-lap lap iso-ir-158 csISO158Lap }
4926 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
4927 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
4930 { JIS_X0201 X0201 csHalfWidthKatakana }
4931 { KSC5636 ISO646-KR csKSC5636 }
4932 { ISO-10646-UCS-2 csUnicode }
4933 { ISO-10646-UCS-4 csUCS4 }
4934 { DEC-MCS dec csDECMCS }
4935 { hp-roman8 roman8 r8 csHPRoman8 }
4936 { macintosh mac csMacintosh }
4937 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
4939 { IBM038 EBCDIC-INT cp038 csIBM038 }
4940 { IBM273 CP273 csIBM273 }
4941 { IBM274 EBCDIC-BE CP274 csIBM274 }
4942 { IBM275 EBCDIC-BR cp275 csIBM275 }
4943 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
4944 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
4945 { IBM280 CP280 ebcdic-cp-it csIBM280 }
4946 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
4947 { IBM284 CP284 ebcdic-cp-es csIBM284 }
4948 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
4949 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
4950 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
4951 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
4952 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
4953 { IBM424 cp424 ebcdic-cp-he csIBM424 }
4954 { IBM437 cp437 437 csPC8CodePage437 }
4955 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
4956 { IBM775 cp775 csPC775Baltic }
4957 { IBM850 cp850 850 csPC850Multilingual }
4958 { IBM851 cp851 851 csIBM851 }
4959 { IBM852 cp852 852 csPCp852 }
4960 { IBM855 cp855 855 csIBM855 }
4961 { IBM857 cp857 857 csIBM857 }
4962 { IBM860 cp860 860 csIBM860 }
4963 { IBM861 cp861 861 cp-is csIBM861 }
4964 { IBM862 cp862 862 csPC862LatinHebrew }
4965 { IBM863 cp863 863 csIBM863 }
4966 { IBM864 cp864 csIBM864 }
4967 { IBM865 cp865 865 csIBM865 }
4968 { IBM866 cp866 866 csIBM866 }
4969 { IBM868 CP868 cp-ar csIBM868 }
4970 { IBM869 cp869 869 cp-gr csIBM869 }
4971 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
4972 { IBM871 CP871 ebcdic-cp-is csIBM871 }
4973 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
4974 { IBM891 cp891 csIBM891 }
4975 { IBM903 cp903 csIBM903 }
4976 { IBM904 cp904 904 csIBBM904 }
4977 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
4978 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
4979 { IBM1026 CP1026 csIBM1026 }
4980 { EBCDIC-AT-DE csIBMEBCDICATDE }
4981 { EBCDIC-AT-DE-A csEBCDICATDEA }
4982 { EBCDIC-CA-FR csEBCDICCAFR }
4983 { EBCDIC-DK-NO csEBCDICDKNO }
4984 { EBCDIC-DK-NO-A csEBCDICDKNOA }
4985 { EBCDIC-FI-SE csEBCDICFISE }
4986 { EBCDIC-FI-SE-A csEBCDICFISEA }
4987 { EBCDIC-FR csEBCDICFR }
4988 { EBCDIC-IT csEBCDICIT }
4989 { EBCDIC-PT csEBCDICPT }
4990 { EBCDIC-ES csEBCDICES }
4991 { EBCDIC-ES-A csEBCDICESA }
4992 { EBCDIC-ES-S csEBCDICESS }
4993 { EBCDIC-UK csEBCDICUK }
4994 { EBCDIC-US csEBCDICUS }
4995 { UNKNOWN-8BIT csUnknown8BiT }
4996 { MNEMONIC csMnemonic }
5001 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5002 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5003 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5004 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5005 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5006 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5007 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5008 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5009 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5010 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5011 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5012 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5013 { IBM1047 IBM-1047 }
5014 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5015 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5016 { UNICODE-1-1 csUnicode11 }
5019 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5020 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5022 { ISO-8859-15 ISO_8859-15 Latin-9 }
5023 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5024 { GBK CP936 MS936 windows-936 }
5025 { JIS_Encoding csJISEncoding }
5026 { Shift_JIS MS_Kanji csShiftJIS }
5027 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5029 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5030 { ISO-10646-UCS-Basic csUnicodeASCII }
5031 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5032 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5033 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5034 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5035 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5036 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5037 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5038 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5039 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5040 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5041 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5042 { Ventura-US csVenturaUS }
5043 { Ventura-International csVenturaInternational }
5044 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5045 { PC8-Turkish csPC8Turkish }
5046 { IBM-Symbols csIBMSymbols }
5047 { IBM-Thai csIBMThai }
5048 { HP-Legal csHPLegal }
5049 { HP-Pi-font csHPPiFont }
5050 { HP-Math8 csHPMath8 }
5051 { Adobe-Symbol-Encoding csHPPSMath }
5052 { HP-DeskTop csHPDesktop }
5053 { Ventura-Math csVenturaMath }
5054 { Microsoft-Publishing csMicrosoftPublishing }
5055 { Windows-31J csWindows31J }
5060 proc tcl_encoding {enc} {
5061 global encoding_aliases
5062 set names [encoding names]
5063 set lcnames [string tolower $names]
5064 set enc [string tolower $enc]
5065 set i [lsearch -exact $lcnames $enc]
5067 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5068 if {[regsub {^iso[-_]} $enc iso encx]} {
5069 set i [lsearch -exact $lcnames $encx]
5073 foreach l $encoding_aliases {
5074 set ll [string tolower $l]
5075 if {[lsearch -exact $ll $enc] < 0} continue
5076 # look through the aliases for one that tcl knows about
5078 set i [lsearch -exact $lcnames $e]
5080 if {[regsub {^iso[-_]} $e iso ex]} {
5081 set i [lsearch -exact $lcnames $ex]
5090 return [lindex $names $i]
5097 set diffopts "-U 5 -p"
5098 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5102 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5104 if {$gitencoding == ""} {
5105 set gitencoding "utf-8"
5107 set tclencoding [tcl_encoding $gitencoding]
5108 if {$tclencoding == {}} {
5109 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5112 set mainfont {Helvetica 9}
5113 set textfont {Courier 9}
5114 set uifont {Helvetica 9 bold}
5115 set findmergefiles 0
5123 set flistmode "flat"
5124 set cmitmode "patch"
5126 set colors {green red blue magenta darkgrey brown orange}
5128 catch {source ~/.gitk}
5130 font create optionfont -family sans-serif -size -12
5134 switch -regexp -- $arg {
5136 "^-d" { set datemode 1 }
5138 lappend revtreeargs $arg
5143 # check that we can find a .git directory somewhere...
5145 if {![file isdirectory $gitdir]} {
5146 show_error . "Cannot find the git directory \"$gitdir\"."
5150 set cmdline_files {}
5151 set i [lsearch -exact $revtreeargs "--"]
5153 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5154 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5155 } elseif {$revtreeargs ne {}} {
5157 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5158 set cmdline_files [split $f "\n"]
5159 set n [llength $cmdline_files]
5160 set revtreeargs [lrange $revtreeargs 0 end-$n]
5162 # unfortunately we get both stdout and stderr in $err,
5163 # so look for "fatal:".
5164 set i [string first "fatal:" $err]
5166 set err [string range [expr {$i + 6}] end]
5168 show_error . "Bad arguments to gitk:\n$err"
5176 set highlight_names {}
5184 set selectedhlview None
5197 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5198 # create a view for the files/dirs specified on the command line
5202 set viewname(1) "Command line"
5203 set viewfiles(1) $cmdline_files
5204 set viewargs(1) $revtreeargs
5207 .bar.view entryconf 2 -state normal
5208 .bar.view entryconf 3 -state normal
5211 if {[info exists permviews]} {
5212 foreach v $permviews {
5215 set viewname($n) [lindex $v 0]
5216 set viewfiles($n) [lindex $v 1]
5217 set viewargs($n) [lindex $v 2]