2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2005 Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
12 if {[info exists env(GIT_DIR)]} {
19 proc start_rev_list {view} {
20 global startmsecs nextupdate ncmupdate
21 global commfd leftover tclencoding datemode
22 global viewargs viewfiles commitidx
24 set startmsecs [clock clicks -milliseconds]
25 set nextupdate [expr {$startmsecs + 100}]
27 set commitidx($view) 0
28 set args $viewargs($view)
29 if {$viewfiles($view) ne {}} {
30 set args [concat $args "--" $viewfiles($view)]
32 set order "--topo-order"
34 set order "--date-order"
37 set fd [open [concat | git-rev-list --header $order \
38 --parents --boundary --default HEAD $args] r]
40 puts stderr "Error executing git-rev-list: $err"
44 set leftover($view) {}
45 fconfigure $fd -blocking 0 -translation lf
46 if {$tclencoding != {}} {
47 fconfigure $fd -encoding $tclencoding
49 fileevent $fd readable [list getcommitlines $fd $view]
53 proc stop_rev_list {} {
56 if {![info exists commfd($curview)]} return
57 set fd $commfd($curview)
63 unset commfd($curview)
67 global phase canv mainfont curview
71 start_rev_list $curview
72 show_status "Reading commits..."
75 proc getcommitlines {fd view} {
76 global commitlisted nextupdate
77 global leftover commfd
78 global displayorder commitidx commitrow commitdata
79 global parentlist childlist children curview hlview
80 global vparentlist vchildlist vdisporder vcmitlisted
84 if {![eof $fd]} return
88 # set it blocking so we wait for the process to terminate
89 fconfigure $fd -blocking 1
90 if {[catch {close $fd} err]} {
92 if {$view != $curview} {
93 set fv " for the \"$viewname($view)\" view"
95 if {[string range $err 0 4] == "usage"} {
96 set err "Gitk: error reading commits$fv:\
97 bad arguments to git-rev-list."
98 if {$viewname($view) eq "Command line"} {
100 " (Note: arguments to gitk are passed to git-rev-list\
101 to allow selection of commits to be displayed.)"
104 set err "Error reading commits$fv: $err"
108 if {$view == $curview} {
109 after idle finishcommits
116 set i [string first "\0" $stuff $start]
118 append leftover($view) [string range $stuff $start end]
122 set cmit $leftover($view)
123 append cmit [string range $stuff 0 [expr {$i - 1}]]
124 set leftover($view) {}
126 set cmit [string range $stuff $start [expr {$i - 1}]]
128 set start [expr {$i + 1}]
129 set j [string first "\n" $cmit]
133 set ids [string range $cmit 0 [expr {$j - 1}]]
134 if {[string range $ids 0 0] == "-"} {
136 set ids [string range $ids 1 end]
140 if {[string length $id] != 40} {
148 if {[string length $shortcmit] > 80} {
149 set shortcmit "[string range $shortcmit 0 80]..."
151 error_popup "Can't parse git-rev-list output: {$shortcmit}"
154 set id [lindex $ids 0]
156 set olds [lrange $ids 1 end]
159 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
160 lappend children($view,$p) $id
167 if {![info exists children($view,$id)]} {
168 set children($view,$id) {}
170 set commitdata($id) [string range $cmit [expr {$j + 1}] end]
171 set commitrow($view,$id) $commitidx($view)
172 incr commitidx($view)
173 if {$view == $curview} {
174 lappend parentlist $olds
175 lappend childlist $children($view,$id)
176 lappend displayorder $id
177 lappend commitlisted $listed
179 lappend vparentlist($view) $olds
180 lappend vchildlist($view) $children($view,$id)
181 lappend vdisporder($view) $id
182 lappend vcmitlisted($view) $listed
187 if {$view == $curview} {
189 } elseif {[info exists hlview] && $view == $hlview} {
193 if {[clock clicks -milliseconds] >= $nextupdate} {
199 global commfd nextupdate numcommits ncmupdate
201 foreach v [array names commfd] {
202 fileevent $commfd($v) readable {}
205 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
206 if {$numcommits < 100} {
207 set ncmupdate [expr {$numcommits + 1}]
208 } elseif {$numcommits < 10000} {
209 set ncmupdate [expr {$numcommits + 10}]
211 set ncmupdate [expr {$numcommits + 100}]
213 foreach v [array names commfd] {
215 fileevent $fd readable [list getcommitlines $fd $v]
219 proc readcommit {id} {
220 if {[catch {set contents [exec git-cat-file commit $id]}]} return
221 parsecommit $id $contents 0
224 proc updatecommits {} {
225 global viewdata curview phase displayorder
226 global children commitrow selectedline thickerline
233 foreach id $displayorder {
234 catch {unset children($n,$id)}
235 catch {unset commitrow($n,$id)}
238 catch {unset selectedline}
239 catch {unset thickerline}
240 catch {unset viewdata($n)}
245 proc parsecommit {id contents listed} {
246 global commitinfo cdate
255 set hdrend [string first "\n\n" $contents]
257 # should never happen...
258 set hdrend [string length $contents]
260 set header [string range $contents 0 [expr {$hdrend - 1}]]
261 set comment [string range $contents [expr {$hdrend + 2}] end]
262 foreach line [split $header "\n"] {
263 set tag [lindex $line 0]
264 if {$tag == "author"} {
265 set audate [lindex $line end-1]
266 set auname [lrange $line 1 end-2]
267 } elseif {$tag == "committer"} {
268 set comdate [lindex $line end-1]
269 set comname [lrange $line 1 end-2]
273 # take the first line of the comment as the headline
274 set i [string first "\n" $comment]
276 set headline [string trim [string range $comment 0 $i]]
278 set headline $comment
281 # git-rev-list indents the comment by 4 spaces;
282 # if we got this via git-cat-file, add the indentation
284 foreach line [split $comment "\n"] {
285 append newcomment " "
286 append newcomment $line
287 append newcomment "\n"
289 set comment $newcomment
291 if {$comdate != {}} {
292 set cdate($id) $comdate
294 set commitinfo($id) [list $headline $auname $audate \
295 $comname $comdate $comment]
298 proc getcommit {id} {
299 global commitdata commitinfo
301 if {[info exists commitdata($id)]} {
302 parsecommit $id $commitdata($id) 1
305 if {![info exists commitinfo($id)]} {
306 set commitinfo($id) {"No commit information available"}
313 global tagids idtags headids idheads tagcontents
314 global otherrefids idotherrefs
316 foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
319 set refd [open [list | git ls-remote [gitdir]] r]
320 while {0 <= [set n [gets $refd line]]} {
321 if {![regexp {^([0-9a-f]{40}) refs/([^^]*)$} $line \
325 if {[regexp {^remotes/.*/HEAD$} $path match]} {
328 if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
332 if {[regexp {^remotes/} $path match]} {
335 if {$type == "tags"} {
336 set tagids($name) $id
337 lappend idtags($id) $name
342 set commit [exec git-rev-parse "$id^0"]
343 if {"$commit" != "$id"} {
344 set tagids($name) $commit
345 lappend idtags($commit) $name
349 set tagcontents($name) [exec git-cat-file tag "$id"]
351 } elseif { $type == "heads" } {
352 set headids($name) $id
353 lappend idheads($id) $name
355 set otherrefids($name) $id
356 lappend idotherrefs($id) $name
362 proc show_error {w msg} {
363 message $w.m -text $msg -justify center -aspect 400
364 pack $w.m -side top -fill x -padx 20 -pady 20
365 button $w.ok -text OK -command "destroy $w"
366 pack $w.ok -side bottom -fill x
367 bind $w <Visibility> "grab $w; focus $w"
368 bind $w <Key-Return> "destroy $w"
372 proc error_popup msg {
380 global canv canv2 canv3 linespc charspc ctext cflist
381 global textfont mainfont uifont
382 global findtype findtypemenu findloc findstring fstring geometry
383 global entries sha1entry sha1string sha1but
384 global maincursor textcursor curtextcursor
385 global rowctxmenu mergemax
386 global highlight_files gdttype
387 global searchstring sstring
390 .bar add cascade -label "File" -menu .bar.file
391 .bar configure -font $uifont
393 .bar.file add command -label "Update" -command updatecommits
394 .bar.file add command -label "Reread references" -command rereadrefs
395 .bar.file add command -label "Quit" -command doquit
396 .bar.file configure -font $uifont
398 .bar add cascade -label "Edit" -menu .bar.edit
399 .bar.edit add command -label "Preferences" -command doprefs
400 .bar.edit configure -font $uifont
402 menu .bar.view -font $uifont
403 .bar add cascade -label "View" -menu .bar.view
404 .bar.view add command -label "New view..." -command {newview 0}
405 .bar.view add command -label "Edit view..." -command editview \
407 .bar.view add command -label "Delete view" -command delview -state disabled
408 .bar.view add separator
409 .bar.view add radiobutton -label "All files" -command {showview 0} \
410 -variable selectedview -value 0
413 .bar add cascade -label "Help" -menu .bar.help
414 .bar.help add command -label "About gitk" -command about
415 .bar.help add command -label "Key bindings" -command keys
416 .bar.help configure -font $uifont
417 . configure -menu .bar
419 if {![info exists geometry(canv1)]} {
420 set geometry(canv1) [expr {45 * $charspc}]
421 set geometry(canv2) [expr {30 * $charspc}]
422 set geometry(canv3) [expr {15 * $charspc}]
423 set geometry(canvh) [expr {25 * $linespc + 4}]
424 set geometry(ctextw) 80
425 set geometry(ctexth) 30
426 set geometry(cflistw) 30
428 panedwindow .ctop -orient vertical
429 if {[info exists geometry(width)]} {
430 .ctop conf -width $geometry(width) -height $geometry(height)
431 set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
432 set geometry(ctexth) [expr {($texth - 8) /
433 [font metrics $textfont -linespace]}]
438 pack .ctop.top.lbar -side bottom -fill x
439 pack .ctop.top.bar -side bottom -fill x
440 set cscroll .ctop.top.csb
441 scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
442 pack $cscroll -side right -fill y
443 panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
444 pack .ctop.top.clist -side top -fill both -expand 1
446 set canv .ctop.top.clist.canv
447 canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
449 -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
450 .ctop.top.clist add $canv
451 set canv2 .ctop.top.clist.canv2
452 canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
453 -bg white -bd 0 -yscrollincr $linespc
454 .ctop.top.clist add $canv2
455 set canv3 .ctop.top.clist.canv3
456 canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
457 -bg white -bd 0 -yscrollincr $linespc
458 .ctop.top.clist add $canv3
459 bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
461 set sha1entry .ctop.top.bar.sha1
462 set entries $sha1entry
463 set sha1but .ctop.top.bar.sha1label
464 button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
465 -command gotocommit -width 8 -font $uifont
466 $sha1but conf -disabledforeground [$sha1but cget -foreground]
467 pack .ctop.top.bar.sha1label -side left
468 entry $sha1entry -width 40 -font $textfont -textvariable sha1string
469 trace add variable sha1string write sha1change
470 pack $sha1entry -side left -pady 2
472 image create bitmap bm-left -data {
473 #define left_width 16
474 #define left_height 16
475 static unsigned char left_bits[] = {
476 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
477 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
478 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
480 image create bitmap bm-right -data {
481 #define right_width 16
482 #define right_height 16
483 static unsigned char right_bits[] = {
484 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
485 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
486 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
488 button .ctop.top.bar.leftbut -image bm-left -command goback \
489 -state disabled -width 26
490 pack .ctop.top.bar.leftbut -side left -fill y
491 button .ctop.top.bar.rightbut -image bm-right -command goforw \
492 -state disabled -width 26
493 pack .ctop.top.bar.rightbut -side left -fill y
495 button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
496 pack .ctop.top.bar.findbut -side left
498 set fstring .ctop.top.bar.findstring
499 lappend entries $fstring
500 entry $fstring -width 30 -font $textfont -textvariable findstring
501 trace add variable findstring write find_change
502 pack $fstring -side left -expand 1 -fill x
504 set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
505 findtype Exact IgnCase Regexp]
506 trace add variable findtype write find_change
507 .ctop.top.bar.findtype configure -font $uifont
508 .ctop.top.bar.findtype.menu configure -font $uifont
509 set findloc "All fields"
510 tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
511 Comments Author Committer
512 trace add variable findloc write find_change
513 .ctop.top.bar.findloc configure -font $uifont
514 .ctop.top.bar.findloc.menu configure -font $uifont
515 pack .ctop.top.bar.findloc -side right
516 pack .ctop.top.bar.findtype -side right
518 label .ctop.top.lbar.flabel -text "Highlight: Commits " \
520 pack .ctop.top.lbar.flabel -side left -fill y
521 set gdttype "touching paths:"
522 set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
523 "adding/removing string:"]
524 trace add variable gdttype write hfiles_change
525 $gm conf -font $uifont
526 .ctop.top.lbar.gdttype conf -font $uifont
527 pack .ctop.top.lbar.gdttype -side left -fill y
528 entry .ctop.top.lbar.fent -width 25 -font $textfont \
529 -textvariable highlight_files
530 trace add variable highlight_files write hfiles_change
531 lappend entries .ctop.top.lbar.fent
532 pack .ctop.top.lbar.fent -side left -fill x -expand 1
533 label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
534 pack .ctop.top.lbar.vlabel -side left -fill y
535 global viewhlmenu selectedhlview
536 set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
537 $viewhlmenu entryconf 0 -command delvhighlight
538 $viewhlmenu conf -font $uifont
539 .ctop.top.lbar.vhl conf -font $uifont
540 pack .ctop.top.lbar.vhl -side left -fill y
541 label .ctop.top.lbar.rlabel -text " OR " -font $uifont
542 pack .ctop.top.lbar.rlabel -side left -fill y
543 global highlight_related
544 set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
545 "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
546 $m conf -font $uifont
547 .ctop.top.lbar.relm conf -font $uifont
548 trace add variable highlight_related write vrel_change
549 pack .ctop.top.lbar.relm -side left -fill y
551 panedwindow .ctop.cdet -orient horizontal
553 frame .ctop.cdet.left
554 frame .ctop.cdet.left.bot
555 pack .ctop.cdet.left.bot -side bottom -fill x
556 button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
558 pack .ctop.cdet.left.bot.search -side left -padx 5
559 set sstring .ctop.cdet.left.bot.sstring
560 entry $sstring -width 20 -font $textfont -textvariable searchstring
561 lappend entries $sstring
562 trace add variable searchstring write incrsearch
563 pack $sstring -side left -expand 1 -fill x
564 set ctext .ctop.cdet.left.ctext
565 text $ctext -bg white -state disabled -font $textfont \
566 -width $geometry(ctextw) -height $geometry(ctexth) \
567 -yscrollcommand scrolltext -wrap none
568 scrollbar .ctop.cdet.left.sb -command "$ctext yview"
569 pack .ctop.cdet.left.sb -side right -fill y
570 pack $ctext -side left -fill both -expand 1
571 .ctop.cdet add .ctop.cdet.left
573 $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
574 $ctext tag conf hunksep -fore blue
575 $ctext tag conf d0 -fore red
576 $ctext tag conf d1 -fore "#00a000"
577 $ctext tag conf m0 -fore red
578 $ctext tag conf m1 -fore blue
579 $ctext tag conf m2 -fore green
580 $ctext tag conf m3 -fore purple
581 $ctext tag conf m4 -fore brown
582 $ctext tag conf m5 -fore "#009090"
583 $ctext tag conf m6 -fore magenta
584 $ctext tag conf m7 -fore "#808000"
585 $ctext tag conf m8 -fore "#009000"
586 $ctext tag conf m9 -fore "#ff0080"
587 $ctext tag conf m10 -fore cyan
588 $ctext tag conf m11 -fore "#b07070"
589 $ctext tag conf m12 -fore "#70b0f0"
590 $ctext tag conf m13 -fore "#70f0b0"
591 $ctext tag conf m14 -fore "#f0b070"
592 $ctext tag conf m15 -fore "#ff70b0"
593 $ctext tag conf mmax -fore darkgrey
595 $ctext tag conf mresult -font [concat $textfont bold]
596 $ctext tag conf msep -font [concat $textfont bold]
597 $ctext tag conf found -back yellow
599 frame .ctop.cdet.right
600 frame .ctop.cdet.right.mode
601 radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
602 -command reselectline -variable cmitmode -value "patch"
603 radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
604 -command reselectline -variable cmitmode -value "tree"
605 grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
606 pack .ctop.cdet.right.mode -side top -fill x
607 set cflist .ctop.cdet.right.cfiles
608 set indent [font measure $mainfont "nn"]
609 text $cflist -width $geometry(cflistw) -background white -font $mainfont \
610 -tabs [list $indent [expr {2 * $indent}]] \
611 -yscrollcommand ".ctop.cdet.right.sb set" \
612 -cursor [. cget -cursor] \
613 -spacing1 1 -spacing3 1
614 scrollbar .ctop.cdet.right.sb -command "$cflist yview"
615 pack .ctop.cdet.right.sb -side right -fill y
616 pack $cflist -side left -fill both -expand 1
617 $cflist tag configure highlight \
618 -background [$cflist cget -selectbackground]
619 $cflist tag configure bold -font [concat $mainfont bold]
620 .ctop.cdet add .ctop.cdet.right
621 bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
623 pack .ctop -side top -fill both -expand 1
625 bindall <1> {selcanvline %W %x %y}
626 #bindall <B1-Motion> {selcanvline %W %x %y}
627 bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
628 bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
629 bindall <2> "canvscan mark %W %x %y"
630 bindall <B2-Motion> "canvscan dragto %W %x %y"
631 bindkey <Home> selfirstline
632 bindkey <End> sellastline
633 bind . <Key-Up> "selnextline -1"
634 bind . <Key-Down> "selnextline 1"
635 bind . <Shift-Key-Up> "next_highlight -1"
636 bind . <Shift-Key-Down> "next_highlight 1"
637 bindkey <Key-Right> "goforw"
638 bindkey <Key-Left> "goback"
639 bind . <Key-Prior> "selnextpage -1"
640 bind . <Key-Next> "selnextpage 1"
641 bind . <Control-Home> "allcanvs yview moveto 0.0"
642 bind . <Control-End> "allcanvs yview moveto 1.0"
643 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
644 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
645 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
646 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
647 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
648 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
649 bindkey <Key-space> "$ctext yview scroll 1 pages"
650 bindkey p "selnextline -1"
651 bindkey n "selnextline 1"
654 bindkey i "selnextline -1"
655 bindkey k "selnextline 1"
658 bindkey b "$ctext yview scroll -1 pages"
659 bindkey d "$ctext yview scroll 18 units"
660 bindkey u "$ctext yview scroll -18 units"
661 bindkey / {findnext 1}
662 bindkey <Key-Return> {findnext 0}
665 bind . <Control-q> doquit
666 bind . <Control-f> dofind
667 bind . <Control-g> {findnext 0}
668 bind . <Control-r> dosearchback
669 bind . <Control-s> dosearch
670 bind . <Control-equal> {incrfont 1}
671 bind . <Control-KP_Add> {incrfont 1}
672 bind . <Control-minus> {incrfont -1}
673 bind . <Control-KP_Subtract> {incrfont -1}
674 bind . <Destroy> {savestuff %W}
675 bind . <Button-1> "click %W"
676 bind $fstring <Key-Return> dofind
677 bind $sha1entry <Key-Return> gotocommit
678 bind $sha1entry <<PasteSelection>> clearsha1
679 bind $cflist <1> {sel_flist %W %x %y; break}
680 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
681 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
683 set maincursor [. cget -cursor]
684 set textcursor [$ctext cget -cursor]
685 set curtextcursor $textcursor
687 set rowctxmenu .rowctxmenu
688 menu $rowctxmenu -tearoff 0
689 $rowctxmenu add command -label "Diff this -> selected" \
690 -command {diffvssel 0}
691 $rowctxmenu add command -label "Diff selected -> this" \
692 -command {diffvssel 1}
693 $rowctxmenu add command -label "Make patch" -command mkpatch
694 $rowctxmenu add command -label "Create tag" -command mktag
695 $rowctxmenu add command -label "Write commit to file" -command writecommit
698 # mouse-2 makes all windows scan vertically, but only the one
699 # the cursor is in scans horizontally
700 proc canvscan {op w x y} {
701 global canv canv2 canv3
702 foreach c [list $canv $canv2 $canv3] {
711 proc scrollcanv {cscroll f0 f1} {
717 # when we make a key binding for the toplevel, make sure
718 # it doesn't get triggered when that key is pressed in the
719 # find string entry widget.
720 proc bindkey {ev script} {
723 set escript [bind Entry $ev]
724 if {$escript == {}} {
725 set escript [bind Entry <Key>]
728 bind $e $ev "$escript; break"
732 # set the focus back to the toplevel for any click outside
743 global canv canv2 canv3 ctext cflist mainfont textfont uifont
744 global stuffsaved findmergefiles maxgraphpct
746 global viewname viewfiles viewargs viewperm nextviewnum
749 if {$stuffsaved} return
750 if {![winfo viewable .]} return
752 set f [open "~/.gitk-new" w]
753 puts $f [list set mainfont $mainfont]
754 puts $f [list set textfont $textfont]
755 puts $f [list set uifont $uifont]
756 puts $f [list set findmergefiles $findmergefiles]
757 puts $f [list set maxgraphpct $maxgraphpct]
758 puts $f [list set maxwidth $maxwidth]
759 puts $f [list set cmitmode $cmitmode]
760 puts $f "set geometry(width) [winfo width .ctop]"
761 puts $f "set geometry(height) [winfo height .ctop]"
762 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
763 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
764 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
765 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
766 set wid [expr {([winfo width $ctext] - 8) \
767 / [font measure $textfont "0"]}]
768 puts $f "set geometry(ctextw) $wid"
769 set wid [expr {([winfo width $cflist] - 11) \
770 / [font measure [$cflist cget -font] "0"]}]
771 puts $f "set geometry(cflistw) $wid"
772 puts -nonewline $f "set permviews {"
773 for {set v 0} {$v < $nextviewnum} {incr v} {
775 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
780 file rename -force "~/.gitk-new" "~/.gitk"
785 proc resizeclistpanes {win w} {
787 if {[info exists oldwidth($win)]} {
788 set s0 [$win sash coord 0]
789 set s1 [$win sash coord 1]
791 set sash0 [expr {int($w/2 - 2)}]
792 set sash1 [expr {int($w*5/6 - 2)}]
794 set factor [expr {1.0 * $w / $oldwidth($win)}]
795 set sash0 [expr {int($factor * [lindex $s0 0])}]
796 set sash1 [expr {int($factor * [lindex $s1 0])}]
800 if {$sash1 < $sash0 + 20} {
801 set sash1 [expr {$sash0 + 20}]
803 if {$sash1 > $w - 10} {
804 set sash1 [expr {$w - 10}]
805 if {$sash0 > $sash1 - 20} {
806 set sash0 [expr {$sash1 - 20}]
810 $win sash place 0 $sash0 [lindex $s0 1]
811 $win sash place 1 $sash1 [lindex $s1 1]
813 set oldwidth($win) $w
816 proc resizecdetpanes {win w} {
818 if {[info exists oldwidth($win)]} {
819 set s0 [$win sash coord 0]
821 set sash0 [expr {int($w*3/4 - 2)}]
823 set factor [expr {1.0 * $w / $oldwidth($win)}]
824 set sash0 [expr {int($factor * [lindex $s0 0])}]
828 if {$sash0 > $w - 15} {
829 set sash0 [expr {$w - 15}]
832 $win sash place 0 $sash0 [lindex $s0 1]
834 set oldwidth($win) $w
838 global canv canv2 canv3
844 proc bindall {event action} {
845 global canv canv2 canv3
846 bind $canv $event $action
847 bind $canv2 $event $action
848 bind $canv3 $event $action
853 if {[winfo exists $w]} {
858 wm title $w "About gitk"
860 Gitk - a commit viewer for git
862 Copyright © 2005-2006 Paul Mackerras
864 Use and redistribute under the terms of the GNU General Public License} \
865 -justify center -aspect 400
866 pack $w.m -side top -fill x -padx 20 -pady 20
867 button $w.ok -text Close -command "destroy $w"
868 pack $w.ok -side bottom
873 if {[winfo exists $w]} {
878 wm title $w "Gitk key bindings"
883 <Home> Move to first commit
884 <End> Move to last commit
885 <Up>, p, i Move up one commit
886 <Down>, n, k Move down one commit
887 <Left>, z, j Go back in history list
888 <Right>, x, l Go forward in history list
889 <PageUp> Move up one page in commit list
890 <PageDown> Move down one page in commit list
891 <Ctrl-Home> Scroll to top of commit list
892 <Ctrl-End> Scroll to bottom of commit list
893 <Ctrl-Up> Scroll commit list up one line
894 <Ctrl-Down> Scroll commit list down one line
895 <Ctrl-PageUp> Scroll commit list up one page
896 <Ctrl-PageDown> Scroll commit list down one page
897 <Shift-Up> Move to previous highlighted line
898 <Shift-Down> Move to next highlighted line
899 <Delete>, b Scroll diff view up one page
900 <Backspace> Scroll diff view up one page
901 <Space> Scroll diff view down one page
902 u Scroll diff view up 18 lines
903 d Scroll diff view down 18 lines
905 <Ctrl-G> Move to next find hit
906 <Return> Move to next find hit
907 / Move to next find hit, or redo find
908 ? Move to previous find hit
909 f Scroll diff view to next file
910 <Ctrl-S> Search for next hit in diff view
911 <Ctrl-R> Search for previous hit in diff view
912 <Ctrl-KP+> Increase font size
913 <Ctrl-plus> Increase font size
914 <Ctrl-KP-> Decrease font size
915 <Ctrl-minus> Decrease font size
917 -justify left -bg white -border 2 -relief sunken
918 pack $w.m -side top -fill both
919 button $w.ok -text Close -command "destroy $w"
920 pack $w.ok -side bottom
923 # Procedures for manipulating the file list window at the
924 # bottom right of the overall window.
926 proc treeview {w l openlevs} {
927 global treecontents treediropen treeheight treeparent treeindex
937 set treecontents() {}
938 $w conf -state normal
940 while {[string range $f 0 $prefixend] ne $prefix} {
941 if {$lev <= $openlevs} {
942 $w mark set e:$treeindex($prefix) "end -1c"
943 $w mark gravity e:$treeindex($prefix) left
945 set treeheight($prefix) $ht
946 incr ht [lindex $htstack end]
947 set htstack [lreplace $htstack end end]
948 set prefixend [lindex $prefendstack end]
949 set prefendstack [lreplace $prefendstack end end]
950 set prefix [string range $prefix 0 $prefixend]
953 set tail [string range $f [expr {$prefixend+1}] end]
954 while {[set slash [string first "/" $tail]] >= 0} {
957 lappend prefendstack $prefixend
958 incr prefixend [expr {$slash + 1}]
959 set d [string range $tail 0 $slash]
960 lappend treecontents($prefix) $d
961 set oldprefix $prefix
963 set treecontents($prefix) {}
964 set treeindex($prefix) [incr ix]
965 set treeparent($prefix) $oldprefix
966 set tail [string range $tail [expr {$slash+1}] end]
967 if {$lev <= $openlevs} {
969 set treediropen($prefix) [expr {$lev < $openlevs}]
970 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
971 $w mark set d:$ix "end -1c"
972 $w mark gravity d:$ix left
974 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
976 $w image create end -align center -image $bm -padx 1 \
978 $w insert end $d [highlight_tag $prefix]
979 $w mark set s:$ix "end -1c"
980 $w mark gravity s:$ix left
985 if {$lev <= $openlevs} {
988 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
990 $w insert end $tail [highlight_tag $f]
992 lappend treecontents($prefix) $tail
995 while {$htstack ne {}} {
996 set treeheight($prefix) $ht
997 incr ht [lindex $htstack end]
998 set htstack [lreplace $htstack end end]
1000 $w conf -state disabled
1003 proc linetoelt {l} {
1004 global treeheight treecontents
1009 foreach e $treecontents($prefix) {
1014 if {[string index $e end] eq "/"} {
1015 set n $treeheight($prefix$e)
1027 proc highlight_tree {y prefix} {
1028 global treeheight treecontents cflist
1030 foreach e $treecontents($prefix) {
1032 if {[highlight_tag $path] ne {}} {
1033 $cflist tag add bold $y.0 "$y.0 lineend"
1036 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1037 set y [highlight_tree $y $path]
1043 proc treeclosedir {w dir} {
1044 global treediropen treeheight treeparent treeindex
1046 set ix $treeindex($dir)
1047 $w conf -state normal
1048 $w delete s:$ix e:$ix
1049 set treediropen($dir) 0
1050 $w image configure a:$ix -image tri-rt
1051 $w conf -state disabled
1052 set n [expr {1 - $treeheight($dir)}]
1053 while {$dir ne {}} {
1054 incr treeheight($dir) $n
1055 set dir $treeparent($dir)
1059 proc treeopendir {w dir} {
1060 global treediropen treeheight treeparent treecontents treeindex
1062 set ix $treeindex($dir)
1063 $w conf -state normal
1064 $w image configure a:$ix -image tri-dn
1065 $w mark set e:$ix s:$ix
1066 $w mark gravity e:$ix right
1069 set n [llength $treecontents($dir)]
1070 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1073 incr treeheight($x) $n
1075 foreach e $treecontents($dir) {
1077 if {[string index $e end] eq "/"} {
1078 set iy $treeindex($de)
1079 $w mark set d:$iy e:$ix
1080 $w mark gravity d:$iy left
1081 $w insert e:$ix $str
1082 set treediropen($de) 0
1083 $w image create e:$ix -align center -image tri-rt -padx 1 \
1085 $w insert e:$ix $e [highlight_tag $de]
1086 $w mark set s:$iy e:$ix
1087 $w mark gravity s:$iy left
1088 set treeheight($de) 1
1090 $w insert e:$ix $str
1091 $w insert e:$ix $e [highlight_tag $de]
1094 $w mark gravity e:$ix left
1095 $w conf -state disabled
1096 set treediropen($dir) 1
1097 set top [lindex [split [$w index @0,0] .] 0]
1098 set ht [$w cget -height]
1099 set l [lindex [split [$w index s:$ix] .] 0]
1102 } elseif {$l + $n + 1 > $top + $ht} {
1103 set top [expr {$l + $n + 2 - $ht}]
1111 proc treeclick {w x y} {
1112 global treediropen cmitmode ctext cflist cflist_top
1114 if {$cmitmode ne "tree"} return
1115 if {![info exists cflist_top]} return
1116 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1117 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1118 $cflist tag add highlight $l.0 "$l.0 lineend"
1124 set e [linetoelt $l]
1125 if {[string index $e end] ne "/"} {
1127 } elseif {$treediropen($e)} {
1134 proc setfilelist {id} {
1135 global treefilelist cflist
1137 treeview $cflist $treefilelist($id) 0
1140 image create bitmap tri-rt -background black -foreground blue -data {
1141 #define tri-rt_width 13
1142 #define tri-rt_height 13
1143 static unsigned char tri-rt_bits[] = {
1144 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1145 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1148 #define tri-rt-mask_width 13
1149 #define tri-rt-mask_height 13
1150 static unsigned char tri-rt-mask_bits[] = {
1151 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1152 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1155 image create bitmap tri-dn -background black -foreground blue -data {
1156 #define tri-dn_width 13
1157 #define tri-dn_height 13
1158 static unsigned char tri-dn_bits[] = {
1159 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1160 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1163 #define tri-dn-mask_width 13
1164 #define tri-dn-mask_height 13
1165 static unsigned char tri-dn-mask_bits[] = {
1166 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1167 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1171 proc init_flist {first} {
1172 global cflist cflist_top selectedline difffilestart
1174 $cflist conf -state normal
1175 $cflist delete 0.0 end
1177 $cflist insert end $first
1179 $cflist tag add highlight 1.0 "1.0 lineend"
1181 catch {unset cflist_top}
1183 $cflist conf -state disabled
1184 set difffilestart {}
1187 proc highlight_tag {f} {
1188 global highlight_paths
1190 foreach p $highlight_paths {
1191 if {[string match $p $f]} {
1198 proc highlight_filelist {} {
1199 global cmitmode cflist
1201 $cflist conf -state normal
1202 if {$cmitmode ne "tree"} {
1203 set end [lindex [split [$cflist index end] .] 0]
1204 for {set l 2} {$l < $end} {incr l} {
1205 set line [$cflist get $l.0 "$l.0 lineend"]
1206 if {[highlight_tag $line] ne {}} {
1207 $cflist tag add bold $l.0 "$l.0 lineend"
1213 $cflist conf -state disabled
1216 proc unhighlight_filelist {} {
1219 $cflist conf -state normal
1220 $cflist tag remove bold 1.0 end
1221 $cflist conf -state disabled
1224 proc add_flist {fl} {
1227 $cflist conf -state normal
1229 $cflist insert end "\n"
1230 $cflist insert end $f [highlight_tag $f]
1232 $cflist conf -state disabled
1235 proc sel_flist {w x y} {
1236 global ctext difffilestart cflist cflist_top cmitmode
1238 if {$cmitmode eq "tree"} return
1239 if {![info exists cflist_top]} return
1240 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1241 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1242 $cflist tag add highlight $l.0 "$l.0 lineend"
1247 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1251 # Functions for adding and removing shell-type quoting
1253 proc shellquote {str} {
1254 if {![string match "*\['\"\\ \t]*" $str]} {
1257 if {![string match "*\['\"\\]*" $str]} {
1260 if {![string match "*'*" $str]} {
1263 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1266 proc shellarglist {l} {
1272 append str [shellquote $a]
1277 proc shelldequote {str} {
1282 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1283 append ret [string range $str $used end]
1284 set used [string length $str]
1287 set first [lindex $first 0]
1288 set ch [string index $str $first]
1289 if {$first > $used} {
1290 append ret [string range $str $used [expr {$first - 1}]]
1293 if {$ch eq " " || $ch eq "\t"} break
1296 set first [string first "'" $str $used]
1298 error "unmatched single-quote"
1300 append ret [string range $str $used [expr {$first - 1}]]
1305 if {$used >= [string length $str]} {
1306 error "trailing backslash"
1308 append ret [string index $str $used]
1313 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1314 error "unmatched double-quote"
1316 set first [lindex $first 0]
1317 set ch [string index $str $first]
1318 if {$first > $used} {
1319 append ret [string range $str $used [expr {$first - 1}]]
1322 if {$ch eq "\""} break
1324 append ret [string index $str $used]
1328 return [list $used $ret]
1331 proc shellsplit {str} {
1334 set str [string trimleft $str]
1335 if {$str eq {}} break
1336 set dq [shelldequote $str]
1337 set n [lindex $dq 0]
1338 set word [lindex $dq 1]
1339 set str [string range $str $n end]
1345 # Code to implement multiple views
1347 proc newview {ishighlight} {
1348 global nextviewnum newviewname newviewperm uifont newishighlight
1349 global newviewargs revtreeargs
1351 set newishighlight $ishighlight
1353 if {[winfo exists $top]} {
1357 set newviewname($nextviewnum) "View $nextviewnum"
1358 set newviewperm($nextviewnum) 0
1359 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1360 vieweditor $top $nextviewnum "Gitk view definition"
1365 global viewname viewperm newviewname newviewperm
1366 global viewargs newviewargs
1368 set top .gitkvedit-$curview
1369 if {[winfo exists $top]} {
1373 set newviewname($curview) $viewname($curview)
1374 set newviewperm($curview) $viewperm($curview)
1375 set newviewargs($curview) [shellarglist $viewargs($curview)]
1376 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1379 proc vieweditor {top n title} {
1380 global newviewname newviewperm viewfiles
1384 wm title $top $title
1385 label $top.nl -text "Name" -font $uifont
1386 entry $top.name -width 20 -textvariable newviewname($n)
1387 grid $top.nl $top.name -sticky w -pady 5
1388 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1389 grid $top.perm - -pady 5 -sticky w
1390 message $top.al -aspect 1000 -font $uifont \
1391 -text "Commits to include (arguments to git-rev-list):"
1392 grid $top.al - -sticky w -pady 5
1393 entry $top.args -width 50 -textvariable newviewargs($n) \
1395 grid $top.args - -sticky ew -padx 5
1396 message $top.l -aspect 1000 -font $uifont \
1397 -text "Enter files and directories to include, one per line:"
1398 grid $top.l - -sticky w
1399 text $top.t -width 40 -height 10 -background white
1400 if {[info exists viewfiles($n)]} {
1401 foreach f $viewfiles($n) {
1402 $top.t insert end $f
1403 $top.t insert end "\n"
1405 $top.t delete {end - 1c} end
1406 $top.t mark set insert 0.0
1408 grid $top.t - -sticky ew -padx 5
1410 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1411 button $top.buts.can -text "Cancel" -command [list destroy $top]
1412 grid $top.buts.ok $top.buts.can
1413 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1414 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1415 grid $top.buts - -pady 10 -sticky ew
1419 proc doviewmenu {m first cmd op argv} {
1420 set nmenu [$m index end]
1421 for {set i $first} {$i <= $nmenu} {incr i} {
1422 if {[$m entrycget $i -command] eq $cmd} {
1423 eval $m $op $i $argv
1429 proc allviewmenus {n op args} {
1432 doviewmenu .bar.view 7 [list showview $n] $op $args
1433 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1436 proc newviewok {top n} {
1437 global nextviewnum newviewperm newviewname newishighlight
1438 global viewname viewfiles viewperm selectedview curview
1439 global viewargs newviewargs viewhlmenu
1442 set newargs [shellsplit $newviewargs($n)]
1444 error_popup "Error in commit selection arguments: $err"
1450 foreach f [split [$top.t get 0.0 end] "\n"] {
1451 set ft [string trim $f]
1456 if {![info exists viewfiles($n)]} {
1457 # creating a new view
1459 set viewname($n) $newviewname($n)
1460 set viewperm($n) $newviewperm($n)
1461 set viewfiles($n) $files
1462 set viewargs($n) $newargs
1464 if {!$newishighlight} {
1465 after idle showview $n
1467 after idle addvhighlight $n
1470 # editing an existing view
1471 set viewperm($n) $newviewperm($n)
1472 if {$newviewname($n) ne $viewname($n)} {
1473 set viewname($n) $newviewname($n)
1474 doviewmenu .bar.view 7 [list showview $n] \
1475 entryconf [list -label $viewname($n)]
1476 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1477 entryconf [list -label $viewname($n) -value $viewname($n)]
1479 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1480 set viewfiles($n) $files
1481 set viewargs($n) $newargs
1482 if {$curview == $n} {
1483 after idle updatecommits
1487 catch {destroy $top}
1491 global curview viewdata viewperm hlview selectedhlview
1493 if {$curview == 0} return
1494 if {[info exists hlview] && $hlview == $curview} {
1495 set selectedhlview None
1498 allviewmenus $curview delete
1499 set viewdata($curview) {}
1500 set viewperm($curview) 0
1504 proc addviewmenu {n} {
1505 global viewname viewhlmenu
1507 .bar.view add radiobutton -label $viewname($n) \
1508 -command [list showview $n] -variable selectedview -value $n
1509 $viewhlmenu add radiobutton -label $viewname($n) \
1510 -command [list addvhighlight $n] -variable selectedhlview
1513 proc flatten {var} {
1517 foreach i [array names $var] {
1518 lappend ret $i [set $var\($i\)]
1523 proc unflatten {var l} {
1533 global curview viewdata viewfiles
1534 global displayorder parentlist childlist rowidlist rowoffsets
1535 global colormap rowtextx commitrow nextcolor canvxmax
1536 global numcommits rowrangelist commitlisted idrowranges
1537 global selectedline currentid canv canvy0
1538 global matchinglines treediffs
1539 global pending_select phase
1540 global commitidx rowlaidout rowoptim linesegends
1541 global commfd nextupdate
1543 global vparentlist vchildlist vdisporder vcmitlisted
1544 global hlview selectedhlview
1546 if {$n == $curview} return
1548 if {[info exists selectedline]} {
1549 set selid $currentid
1550 set y [yc $selectedline]
1551 set ymax [lindex [$canv cget -scrollregion] 3]
1552 set span [$canv yview]
1553 set ytop [expr {[lindex $span 0] * $ymax}]
1554 set ybot [expr {[lindex $span 1] * $ymax}]
1555 if {$ytop < $y && $y < $ybot} {
1556 set yscreen [expr {$y - $ytop}]
1558 set yscreen [expr {($ybot - $ytop) / 2}]
1564 if {$curview >= 0} {
1565 set vparentlist($curview) $parentlist
1566 set vchildlist($curview) $childlist
1567 set vdisporder($curview) $displayorder
1568 set vcmitlisted($curview) $commitlisted
1570 set viewdata($curview) \
1571 [list $phase $rowidlist $rowoffsets $rowrangelist \
1572 [flatten idrowranges] [flatten idinlist] \
1573 $rowlaidout $rowoptim $numcommits $linesegends]
1574 } elseif {![info exists viewdata($curview)]
1575 || [lindex $viewdata($curview) 0] ne {}} {
1576 set viewdata($curview) \
1577 [list {} $rowidlist $rowoffsets $rowrangelist]
1580 catch {unset matchinglines}
1581 catch {unset treediffs}
1583 if {[info exists hlview] && $hlview == $n} {
1585 set selectedhlview None
1590 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1591 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1593 if {![info exists viewdata($n)]} {
1594 set pending_select $selid
1600 set phase [lindex $v 0]
1601 set displayorder $vdisporder($n)
1602 set parentlist $vparentlist($n)
1603 set childlist $vchildlist($n)
1604 set commitlisted $vcmitlisted($n)
1605 set rowidlist [lindex $v 1]
1606 set rowoffsets [lindex $v 2]
1607 set rowrangelist [lindex $v 3]
1609 set numcommits [llength $displayorder]
1610 catch {unset idrowranges}
1612 unflatten idrowranges [lindex $v 4]
1613 unflatten idinlist [lindex $v 5]
1614 set rowlaidout [lindex $v 6]
1615 set rowoptim [lindex $v 7]
1616 set numcommits [lindex $v 8]
1617 set linesegends [lindex $v 9]
1620 catch {unset colormap}
1621 catch {unset rowtextx}
1623 set canvxmax [$canv cget -width]
1629 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1630 set row $commitrow($n,$selid)
1631 # try to get the selected row in the same position on the screen
1632 set ymax [lindex [$canv cget -scrollregion] 3]
1633 set ytop [expr {[yc $row] - $yscreen}]
1637 set yf [expr {$ytop * 1.0 / $ymax}]
1639 allcanvs yview moveto $yf
1643 if {$phase eq "getcommits"} {
1644 show_status "Reading commits..."
1646 if {[info exists commfd($n)]} {
1651 } elseif {$numcommits == 0} {
1652 show_status "No commits selected"
1656 # Stuff relating to the highlighting facility
1658 proc ishighlighted {row} {
1659 global vhighlights fhighlights nhighlights rhighlights
1661 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1662 return $nhighlights($row)
1664 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1665 return $vhighlights($row)
1667 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1668 return $fhighlights($row)
1670 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1671 return $rhighlights($row)
1676 proc bolden {row font} {
1677 global canv linehtag selectedline boldrows
1679 lappend boldrows $row
1680 $canv itemconf $linehtag($row) -font $font
1681 if {[info exists selectedline] && $row == $selectedline} {
1683 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1684 -outline {{}} -tags secsel \
1685 -fill [$canv cget -selectbackground]]
1690 proc bolden_name {row font} {
1691 global canv2 linentag selectedline boldnamerows
1693 lappend boldnamerows $row
1694 $canv2 itemconf $linentag($row) -font $font
1695 if {[info exists selectedline] && $row == $selectedline} {
1696 $canv2 delete secsel
1697 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1698 -outline {{}} -tags secsel \
1699 -fill [$canv2 cget -selectbackground]]
1705 global mainfont boldrows
1708 foreach row $boldrows {
1709 if {![ishighlighted $row]} {
1710 bolden $row $mainfont
1712 lappend stillbold $row
1715 set boldrows $stillbold
1718 proc addvhighlight {n} {
1719 global hlview curview viewdata vhl_done vhighlights commitidx
1721 if {[info exists hlview]} {
1725 if {$n != $curview && ![info exists viewdata($n)]} {
1726 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1727 set vparentlist($n) {}
1728 set vchildlist($n) {}
1729 set vdisporder($n) {}
1730 set vcmitlisted($n) {}
1733 set vhl_done $commitidx($hlview)
1734 if {$vhl_done > 0} {
1739 proc delvhighlight {} {
1740 global hlview vhighlights
1742 if {![info exists hlview]} return
1744 catch {unset vhighlights}
1748 proc vhighlightmore {} {
1749 global hlview vhl_done commitidx vhighlights
1750 global displayorder vdisporder curview mainfont
1752 set font [concat $mainfont bold]
1753 set max $commitidx($hlview)
1754 if {$hlview == $curview} {
1755 set disp $displayorder
1757 set disp $vdisporder($hlview)
1759 set vr [visiblerows]
1760 set r0 [lindex $vr 0]
1761 set r1 [lindex $vr 1]
1762 for {set i $vhl_done} {$i < $max} {incr i} {
1763 set id [lindex $disp $i]
1764 if {[info exists commitrow($curview,$id)]} {
1765 set row $commitrow($curview,$id)
1766 if {$r0 <= $row && $row <= $r1} {
1767 if {![highlighted $row]} {
1770 set vhighlights($row) 1
1777 proc askvhighlight {row id} {
1778 global hlview vhighlights commitrow iddrawn mainfont
1780 if {[info exists commitrow($hlview,$id)]} {
1781 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1782 bolden $row [concat $mainfont bold]
1784 set vhighlights($row) 1
1786 set vhighlights($row) 0
1790 proc hfiles_change {name ix op} {
1791 global highlight_files filehighlight fhighlights fh_serial
1792 global mainfont highlight_paths
1794 if {[info exists filehighlight]} {
1795 # delete previous highlights
1796 catch {close $filehighlight}
1798 catch {unset fhighlights}
1800 unhighlight_filelist
1802 set highlight_paths {}
1803 after cancel do_file_hl $fh_serial
1805 if {$highlight_files ne {}} {
1806 after 300 do_file_hl $fh_serial
1810 proc makepatterns {l} {
1813 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1814 if {[string index $ee end] eq "/"} {
1824 proc do_file_hl {serial} {
1825 global highlight_files filehighlight highlight_paths gdttype fhl_list
1827 if {$gdttype eq "touching paths:"} {
1828 if {[catch {set paths [shellsplit $highlight_files]}]} return
1829 set highlight_paths [makepatterns $paths]
1831 set gdtargs [concat -- $paths]
1833 set gdtargs [list "-S$highlight_files"]
1835 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1836 set filehighlight [open $cmd r+]
1837 fconfigure $filehighlight -blocking 0
1838 fileevent $filehighlight readable readfhighlight
1844 proc flushhighlights {} {
1845 global filehighlight fhl_list
1847 if {[info exists filehighlight]} {
1849 puts $filehighlight ""
1850 flush $filehighlight
1854 proc askfilehighlight {row id} {
1855 global filehighlight fhighlights fhl_list
1857 lappend fhl_list $id
1858 set fhighlights($row) -1
1859 puts $filehighlight $id
1862 proc readfhighlight {} {
1863 global filehighlight fhighlights commitrow curview mainfont iddrawn
1866 while {[gets $filehighlight line] >= 0} {
1867 set line [string trim $line]
1868 set i [lsearch -exact $fhl_list $line]
1869 if {$i < 0} continue
1870 for {set j 0} {$j < $i} {incr j} {
1871 set id [lindex $fhl_list $j]
1872 if {[info exists commitrow($curview,$id)]} {
1873 set fhighlights($commitrow($curview,$id)) 0
1876 set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1877 if {$line eq {}} continue
1878 if {![info exists commitrow($curview,$line)]} continue
1879 set row $commitrow($curview,$line)
1880 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1881 bolden $row [concat $mainfont bold]
1883 set fhighlights($row) 1
1885 if {[eof $filehighlight]} {
1887 puts "oops, git-diff-tree died"
1888 catch {close $filehighlight}
1894 proc find_change {name ix op} {
1895 global nhighlights mainfont boldnamerows
1896 global findstring findpattern findtype
1898 # delete previous highlights, if any
1899 foreach row $boldnamerows {
1900 bolden_name $row $mainfont
1903 catch {unset nhighlights}
1905 if {$findtype ne "Regexp"} {
1906 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1908 set findpattern "*$e*"
1913 proc askfindhighlight {row id} {
1914 global nhighlights commitinfo iddrawn mainfont
1915 global findstring findtype findloc findpattern
1917 if {![info exists commitinfo($id)]} {
1920 set info $commitinfo($id)
1922 set fldtypes {Headline Author Date Committer CDate Comments}
1923 foreach f $info ty $fldtypes {
1924 if {$findloc ne "All fields" && $findloc ne $ty} {
1927 if {$findtype eq "Regexp"} {
1928 set doesmatch [regexp $findstring $f]
1929 } elseif {$findtype eq "IgnCase"} {
1930 set doesmatch [string match -nocase $findpattern $f]
1932 set doesmatch [string match $findpattern $f]
1935 if {$ty eq "Author"} {
1942 if {[info exists iddrawn($id)]} {
1943 if {$isbold && ![ishighlighted $row]} {
1944 bolden $row [concat $mainfont bold]
1947 bolden_name $row [concat $mainfont bold]
1950 set nhighlights($row) $isbold
1953 proc vrel_change {name ix op} {
1954 global highlight_related
1957 if {$highlight_related ne "None"} {
1958 after idle drawvisible
1962 # prepare for testing whether commits are descendents or ancestors of a
1963 proc rhighlight_sel {a} {
1964 global descendent desc_todo ancestor anc_todo
1965 global highlight_related rhighlights
1967 catch {unset descendent}
1968 set desc_todo [list $a]
1969 catch {unset ancestor}
1970 set anc_todo [list $a]
1971 if {$highlight_related ne "None"} {
1973 after idle drawvisible
1977 proc rhighlight_none {} {
1980 catch {unset rhighlights}
1984 proc is_descendent {a} {
1985 global curview children commitrow descendent desc_todo
1988 set la $commitrow($v,$a)
1992 for {set i 0} {$i < [llength $todo]} {incr i} {
1993 set do [lindex $todo $i]
1994 if {$commitrow($v,$do) < $la} {
1995 lappend leftover $do
1998 foreach nk $children($v,$do) {
1999 if {![info exists descendent($nk)]} {
2000 set descendent($nk) 1
2008 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2012 set descendent($a) 0
2013 set desc_todo $leftover
2016 proc is_ancestor {a} {
2017 global curview parentlist commitrow ancestor anc_todo
2020 set la $commitrow($v,$a)
2024 for {set i 0} {$i < [llength $todo]} {incr i} {
2025 set do [lindex $todo $i]
2026 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2027 lappend leftover $do
2030 foreach np [lindex $parentlist $commitrow($v,$do)] {
2031 if {![info exists ancestor($np)]} {
2040 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2045 set anc_todo $leftover
2048 proc askrelhighlight {row id} {
2049 global descendent highlight_related iddrawn mainfont rhighlights
2050 global selectedline ancestor
2052 if {![info exists selectedline]} return
2054 if {$highlight_related eq "Descendent" ||
2055 $highlight_related eq "Not descendent"} {
2056 if {![info exists descendent($id)]} {
2059 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2062 } elseif {$highlight_related eq "Ancestor" ||
2063 $highlight_related eq "Not ancestor"} {
2064 if {![info exists ancestor($id)]} {
2067 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2071 if {[info exists iddrawn($id)]} {
2072 if {$isbold && ![ishighlighted $row]} {
2073 bolden $row [concat $mainfont bold]
2076 set rhighlights($row) $isbold
2079 proc next_hlcont {} {
2080 global fhl_row fhl_dirn displayorder numcommits
2081 global vhighlights fhighlights nhighlights rhighlights
2082 global hlview filehighlight findstring highlight_related
2084 if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2087 if {$row < 0 || $row >= $numcommits} {
2092 set id [lindex $displayorder $row]
2093 if {[info exists hlview]} {
2094 if {![info exists vhighlights($row)]} {
2095 askvhighlight $row $id
2097 if {$vhighlights($row) > 0} break
2099 if {$findstring ne {}} {
2100 if {![info exists nhighlights($row)]} {
2101 askfindhighlight $row $id
2103 if {$nhighlights($row) > 0} break
2105 if {$highlight_related ne "None"} {
2106 if {![info exists rhighlights($row)]} {
2107 askrelhighlight $row $id
2109 if {$rhighlights($row) > 0} break
2111 if {[info exists filehighlight]} {
2112 if {![info exists fhighlights($row)]} {
2113 # ask for a few more while we're at it...
2115 for {set n 0} {$n < 100} {incr n} {
2116 if {![info exists fhighlights($r)]} {
2117 askfilehighlight $r [lindex $displayorder $r]
2120 if {$r < 0 || $r >= $numcommits} break
2124 if {$fhighlights($row) < 0} {
2128 if {$fhighlights($row) > 0} break
2136 proc next_highlight {dirn} {
2137 global selectedline fhl_row fhl_dirn
2138 global hlview filehighlight findstring highlight_related
2140 if {![info exists selectedline]} return
2141 if {!([info exists hlview] || $findstring ne {} ||
2142 $highlight_related ne "None" || [info exists filehighlight])} return
2143 set fhl_row [expr {$selectedline + $dirn}]
2148 proc cancel_next_highlight {} {
2154 # Graph layout functions
2156 proc shortids {ids} {
2159 if {[llength $id] > 1} {
2160 lappend res [shortids $id]
2161 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2162 lappend res [string range $id 0 7]
2170 proc incrange {l x o} {
2173 set e [lindex $l $x]
2175 lset l $x [expr {$e + $o}]
2184 for {} {$n > 0} {incr n -1} {
2190 proc usedinrange {id l1 l2} {
2191 global children commitrow childlist curview
2193 if {[info exists commitrow($curview,$id)]} {
2194 set r $commitrow($curview,$id)
2195 if {$l1 <= $r && $r <= $l2} {
2196 return [expr {$r - $l1 + 1}]
2198 set kids [lindex $childlist $r]
2200 set kids $children($curview,$id)
2203 set r $commitrow($curview,$c)
2204 if {$l1 <= $r && $r <= $l2} {
2205 return [expr {$r - $l1 + 1}]
2211 proc sanity {row {full 0}} {
2212 global rowidlist rowoffsets
2215 set ids [lindex $rowidlist $row]
2218 if {$id eq {}} continue
2219 if {$col < [llength $ids] - 1 &&
2220 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2221 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2223 set o [lindex $rowoffsets $row $col]
2229 if {[lindex $rowidlist $y $x] != $id} {
2230 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2231 puts " id=[shortids $id] check started at row $row"
2232 for {set i $row} {$i >= $y} {incr i -1} {
2233 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2238 set o [lindex $rowoffsets $y $x]
2243 proc makeuparrow {oid x y z} {
2244 global rowidlist rowoffsets uparrowlen idrowranges
2246 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2249 set off0 [lindex $rowoffsets $y]
2250 for {set x0 $x} {1} {incr x0} {
2251 if {$x0 >= [llength $off0]} {
2252 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2255 set z [lindex $off0 $x0]
2261 set z [expr {$x0 - $x}]
2262 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2263 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2265 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2266 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2267 lappend idrowranges($oid) $y
2270 proc initlayout {} {
2271 global rowidlist rowoffsets displayorder commitlisted
2272 global rowlaidout rowoptim
2273 global idinlist rowchk rowrangelist idrowranges
2274 global numcommits canvxmax canv
2276 global parentlist childlist children
2277 global colormap rowtextx
2289 catch {unset idinlist}
2290 catch {unset rowchk}
2293 set canvxmax [$canv cget -width]
2294 catch {unset colormap}
2295 catch {unset rowtextx}
2296 catch {unset idrowranges}
2300 proc setcanvscroll {} {
2301 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2303 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2304 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2305 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2306 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2309 proc visiblerows {} {
2310 global canv numcommits linespc
2312 set ymax [lindex [$canv cget -scrollregion] 3]
2313 if {$ymax eq {} || $ymax == 0} return
2315 set y0 [expr {int([lindex $f 0] * $ymax)}]
2316 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2320 set y1 [expr {int([lindex $f 1] * $ymax)}]
2321 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2322 if {$r1 >= $numcommits} {
2323 set r1 [expr {$numcommits - 1}]
2325 return [list $r0 $r1]
2328 proc layoutmore {} {
2329 global rowlaidout rowoptim commitidx numcommits optim_delay
2330 global uparrowlen curview
2333 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2334 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2335 if {$orow > $rowoptim} {
2336 optimize_rows $rowoptim 0 $orow
2339 set canshow [expr {$rowoptim - $optim_delay}]
2340 if {$canshow > $numcommits} {
2345 proc showstuff {canshow} {
2346 global numcommits commitrow pending_select selectedline
2347 global linesegends idrowranges idrangedrawn curview
2349 if {$numcommits == 0} {
2351 set phase "incrdraw"
2355 set numcommits $canshow
2357 set rows [visiblerows]
2358 set r0 [lindex $rows 0]
2359 set r1 [lindex $rows 1]
2361 for {set r $row} {$r < $canshow} {incr r} {
2362 foreach id [lindex $linesegends [expr {$r+1}]] {
2364 foreach {s e} [rowranges $id] {
2366 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2367 && ![info exists idrangedrawn($id,$i)]} {
2369 set idrangedrawn($id,$i) 1
2374 if {$canshow > $r1} {
2377 while {$row < $canshow} {
2381 if {[info exists pending_select] &&
2382 [info exists commitrow($curview,$pending_select)] &&
2383 $commitrow($curview,$pending_select) < $numcommits} {
2384 selectline $commitrow($curview,$pending_select) 1
2386 if {![info exists selectedline] && ![info exists pending_select]} {
2391 proc layoutrows {row endrow last} {
2392 global rowidlist rowoffsets displayorder
2393 global uparrowlen downarrowlen maxwidth mingaplen
2394 global childlist parentlist
2395 global idrowranges linesegends
2396 global commitidx curview
2397 global idinlist rowchk rowrangelist
2399 set idlist [lindex $rowidlist $row]
2400 set offs [lindex $rowoffsets $row]
2401 while {$row < $endrow} {
2402 set id [lindex $displayorder $row]
2405 foreach p [lindex $parentlist $row] {
2406 if {![info exists idinlist($p)]} {
2408 } elseif {!$idinlist($p)} {
2413 set nev [expr {[llength $idlist] + [llength $newolds]
2414 + [llength $oldolds] - $maxwidth + 1}]
2417 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2418 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2419 set i [lindex $idlist $x]
2420 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2421 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2422 [expr {$row + $uparrowlen + $mingaplen}]]
2424 set idlist [lreplace $idlist $x $x]
2425 set offs [lreplace $offs $x $x]
2426 set offs [incrange $offs $x 1]
2428 set rm1 [expr {$row - 1}]
2430 lappend idrowranges($i) $rm1
2431 if {[incr nev -1] <= 0} break
2434 set rowchk($id) [expr {$row + $r}]
2437 lset rowidlist $row $idlist
2438 lset rowoffsets $row $offs
2440 lappend linesegends $lse
2441 set col [lsearch -exact $idlist $id]
2443 set col [llength $idlist]
2445 lset rowidlist $row $idlist
2447 if {[lindex $childlist $row] ne {}} {
2448 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2452 lset rowoffsets $row $offs
2454 makeuparrow $id $col $row $z
2460 if {[info exists idrowranges($id)]} {
2461 set ranges $idrowranges($id)
2463 unset idrowranges($id)
2465 lappend rowrangelist $ranges
2467 set offs [ntimes [llength $idlist] 0]
2468 set l [llength $newolds]
2469 set idlist [eval lreplace \$idlist $col $col $newolds]
2472 set offs [lrange $offs 0 [expr {$col - 1}]]
2473 foreach x $newolds {
2478 set tmp [expr {[llength $idlist] - [llength $offs]}]
2480 set offs [concat $offs [ntimes $tmp $o]]
2485 foreach i $newolds {
2487 set idrowranges($i) $row
2490 foreach oid $oldolds {
2491 set idinlist($oid) 1
2492 set idlist [linsert $idlist $col $oid]
2493 set offs [linsert $offs $col $o]
2494 makeuparrow $oid $col $row $o
2497 lappend rowidlist $idlist
2498 lappend rowoffsets $offs
2503 proc addextraid {id row} {
2504 global displayorder commitrow commitinfo
2505 global commitidx commitlisted
2506 global parentlist childlist children curview
2508 incr commitidx($curview)
2509 lappend displayorder $id
2510 lappend commitlisted 0
2511 lappend parentlist {}
2512 set commitrow($curview,$id) $row
2514 if {![info exists commitinfo($id)]} {
2515 set commitinfo($id) {"No commit information available"}
2517 if {![info exists children($curview,$id)]} {
2518 set children($curview,$id) {}
2520 lappend childlist $children($curview,$id)
2523 proc layouttail {} {
2524 global rowidlist rowoffsets idinlist commitidx curview
2525 global idrowranges rowrangelist
2527 set row $commitidx($curview)
2528 set idlist [lindex $rowidlist $row]
2529 while {$idlist ne {}} {
2530 set col [expr {[llength $idlist] - 1}]
2531 set id [lindex $idlist $col]
2534 lappend idrowranges($id) $row
2535 lappend rowrangelist $idrowranges($id)
2536 unset idrowranges($id)
2538 set offs [ntimes $col 0]
2539 set idlist [lreplace $idlist $col $col]
2540 lappend rowidlist $idlist
2541 lappend rowoffsets $offs
2544 foreach id [array names idinlist] {
2546 lset rowidlist $row [list $id]
2547 lset rowoffsets $row 0
2548 makeuparrow $id 0 $row 0
2549 lappend idrowranges($id) $row
2550 lappend rowrangelist $idrowranges($id)
2551 unset idrowranges($id)
2553 lappend rowidlist {}
2554 lappend rowoffsets {}
2558 proc insert_pad {row col npad} {
2559 global rowidlist rowoffsets
2561 set pad [ntimes $npad {}]
2562 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2563 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2564 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2567 proc optimize_rows {row col endrow} {
2568 global rowidlist rowoffsets idrowranges displayorder
2570 for {} {$row < $endrow} {incr row} {
2571 set idlist [lindex $rowidlist $row]
2572 set offs [lindex $rowoffsets $row]
2574 for {} {$col < [llength $offs]} {incr col} {
2575 if {[lindex $idlist $col] eq {}} {
2579 set z [lindex $offs $col]
2580 if {$z eq {}} continue
2582 set x0 [expr {$col + $z}]
2583 set y0 [expr {$row - 1}]
2584 set z0 [lindex $rowoffsets $y0 $x0]
2586 set id [lindex $idlist $col]
2587 set ranges [rowranges $id]
2588 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2592 if {$z < -1 || ($z < 0 && $isarrow)} {
2593 set npad [expr {-1 - $z + $isarrow}]
2594 set offs [incrange $offs $col $npad]
2595 insert_pad $y0 $x0 $npad
2597 optimize_rows $y0 $x0 $row
2599 set z [lindex $offs $col]
2600 set x0 [expr {$col + $z}]
2601 set z0 [lindex $rowoffsets $y0 $x0]
2602 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2603 set npad [expr {$z - 1 + $isarrow}]
2604 set y1 [expr {$row + 1}]
2605 set offs2 [lindex $rowoffsets $y1]
2609 if {$z eq {} || $x1 + $z < $col} continue
2610 if {$x1 + $z > $col} {
2613 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2616 set pad [ntimes $npad {}]
2617 set idlist [eval linsert \$idlist $col $pad]
2618 set tmp [eval linsert \$offs $col $pad]
2620 set offs [incrange $tmp $col [expr {-$npad}]]
2621 set z [lindex $offs $col]
2624 if {$z0 eq {} && !$isarrow} {
2625 # this line links to its first child on row $row-2
2626 set rm2 [expr {$row - 2}]
2627 set id [lindex $displayorder $rm2]
2628 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2630 set z0 [expr {$xc - $x0}]
2633 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2634 insert_pad $y0 $x0 1
2635 set offs [incrange $offs $col 1]
2636 optimize_rows $y0 [expr {$x0 + 1}] $row
2641 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2642 set o [lindex $offs $col]
2644 # check if this is the link to the first child
2645 set id [lindex $idlist $col]
2646 set ranges [rowranges $id]
2647 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2648 # it is, work out offset to child
2649 set y0 [expr {$row - 1}]
2650 set id [lindex $displayorder $y0]
2651 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2653 set o [expr {$x0 - $col}]
2657 if {$o eq {} || $o <= 0} break
2659 if {$o ne {} && [incr col] < [llength $idlist]} {
2660 set y1 [expr {$row + 1}]
2661 set offs2 [lindex $rowoffsets $y1]
2665 if {$z eq {} || $x1 + $z < $col} continue
2666 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2669 set idlist [linsert $idlist $col {}]
2670 set tmp [linsert $offs $col {}]
2672 set offs [incrange $tmp $col -1]
2675 lset rowidlist $row $idlist
2676 lset rowoffsets $row $offs
2682 global canvx0 linespc
2683 return [expr {$canvx0 + $col * $linespc}]
2687 global canvy0 linespc
2688 return [expr {$canvy0 + $row * $linespc}]
2691 proc linewidth {id} {
2692 global thickerline lthickness
2695 if {[info exists thickerline] && $id eq $thickerline} {
2696 set wid [expr {2 * $lthickness}]
2701 proc rowranges {id} {
2702 global phase idrowranges commitrow rowlaidout rowrangelist curview
2706 ([info exists commitrow($curview,$id)]
2707 && $commitrow($curview,$id) < $rowlaidout)} {
2708 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2709 } elseif {[info exists idrowranges($id)]} {
2710 set ranges $idrowranges($id)
2715 proc drawlineseg {id i} {
2716 global rowoffsets rowidlist
2718 global canv colormap linespc
2719 global numcommits commitrow curview
2721 set ranges [rowranges $id]
2723 if {[info exists commitrow($curview,$id)]
2724 && $commitrow($curview,$id) < $numcommits} {
2725 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2729 set startrow [lindex $ranges [expr {2 * $i}]]
2730 set row [lindex $ranges [expr {2 * $i + 1}]]
2731 if {$startrow == $row} return
2734 set col [lsearch -exact [lindex $rowidlist $row] $id]
2736 puts "oops: drawline: id $id not on row $row"
2742 set o [lindex $rowoffsets $row $col]
2745 # changing direction
2746 set x [xc $row $col]
2748 lappend coords $x $y
2754 set x [xc $row $col]
2756 lappend coords $x $y
2758 # draw the link to the first child as part of this line
2760 set child [lindex $displayorder $row]
2761 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2763 set x [xc $row $ccol]
2765 if {$ccol < $col - 1} {
2766 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2767 } elseif {$ccol > $col + 1} {
2768 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2770 lappend coords $x $y
2773 if {[llength $coords] < 4} return
2775 # This line has an arrow at the lower end: check if the arrow is
2776 # on a diagonal segment, and if so, work around the Tk 8.4
2777 # refusal to draw arrows on diagonal lines.
2778 set x0 [lindex $coords 0]
2779 set x1 [lindex $coords 2]
2781 set y0 [lindex $coords 1]
2782 set y1 [lindex $coords 3]
2783 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2784 # we have a nearby vertical segment, just trim off the diag bit
2785 set coords [lrange $coords 2 end]
2787 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2788 set xi [expr {$x0 - $slope * $linespc / 2}]
2789 set yi [expr {$y0 - $linespc / 2}]
2790 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2794 set arrow [expr {2 * ($i > 0) + $downarrow}]
2795 set arrow [lindex {none first last both} $arrow]
2796 set t [$canv create line $coords -width [linewidth $id] \
2797 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2802 proc drawparentlinks {id row col olds} {
2803 global rowidlist canv colormap
2805 set row2 [expr {$row + 1}]
2806 set x [xc $row $col]
2809 set ids [lindex $rowidlist $row2]
2810 # rmx = right-most X coord used
2813 set i [lsearch -exact $ids $p]
2815 puts "oops, parent $p of $id not in list"
2818 set x2 [xc $row2 $i]
2822 set ranges [rowranges $p]
2823 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2824 && $row2 < [lindex $ranges 1]} {
2825 # drawlineseg will do this one for us
2829 # should handle duplicated parents here...
2830 set coords [list $x $y]
2831 if {$i < $col - 1} {
2832 lappend coords [xc $row [expr {$i + 1}]] $y
2833 } elseif {$i > $col + 1} {
2834 lappend coords [xc $row [expr {$i - 1}]] $y
2836 lappend coords $x2 $y2
2837 set t [$canv create line $coords -width [linewidth $p] \
2838 -fill $colormap($p) -tags lines.$p]
2845 proc drawlines {id} {
2846 global colormap canv
2848 global children iddrawn commitrow rowidlist curview
2850 $canv delete lines.$id
2851 set nr [expr {[llength [rowranges $id]] / 2}]
2852 for {set i 0} {$i < $nr} {incr i} {
2853 if {[info exists idrangedrawn($id,$i)]} {
2857 foreach child $children($curview,$id) {
2858 if {[info exists iddrawn($child)]} {
2859 set row $commitrow($curview,$child)
2860 set col [lsearch -exact [lindex $rowidlist $row] $child]
2862 drawparentlinks $child $row $col [list $id]
2868 proc drawcmittext {id row col rmx} {
2869 global linespc canv canv2 canv3 canvy0
2870 global commitlisted commitinfo rowidlist
2871 global rowtextx idpos idtags idheads idotherrefs
2872 global linehtag linentag linedtag
2873 global mainfont canvxmax boldrows boldnamerows
2875 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2876 set x [xc $row $col]
2878 set orad [expr {$linespc / 3}]
2879 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2880 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2881 -fill $ofill -outline black -width 1]
2883 $canv bind $t <1> {selcanvline {} %x %y}
2884 set xt [xc $row [llength [lindex $rowidlist $row]]]
2888 set rowtextx($row) $xt
2889 set idpos($id) [list $x $xt $y]
2890 if {[info exists idtags($id)] || [info exists idheads($id)]
2891 || [info exists idotherrefs($id)]} {
2892 set xt [drawtags $id $x $xt $y]
2894 set headline [lindex $commitinfo($id) 0]
2895 set name [lindex $commitinfo($id) 1]
2896 set date [lindex $commitinfo($id) 2]
2897 set date [formatdate $date]
2900 set isbold [ishighlighted $row]
2902 lappend boldrows $row
2905 lappend boldnamerows $row
2909 set linehtag($row) [$canv create text $xt $y -anchor w \
2910 -text $headline -font $font]
2911 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2912 set linentag($row) [$canv2 create text 3 $y -anchor w \
2913 -text $name -font $nfont]
2914 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2915 -text $date -font $mainfont]
2916 set xr [expr {$xt + [font measure $mainfont $headline]}]
2917 if {$xr > $canvxmax} {
2923 proc drawcmitrow {row} {
2924 global displayorder rowidlist
2925 global idrangedrawn iddrawn
2926 global commitinfo parentlist numcommits
2927 global filehighlight fhighlights findstring nhighlights
2928 global hlview vhighlights
2929 global highlight_related rhighlights
2931 if {$row >= $numcommits} return
2932 foreach id [lindex $rowidlist $row] {
2933 if {$id eq {}} continue
2935 foreach {s e} [rowranges $id] {
2937 if {$row < $s} continue
2940 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2942 set idrangedrawn($id,$i) 1
2949 set id [lindex $displayorder $row]
2950 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2951 askvhighlight $row $id
2953 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2954 askfilehighlight $row $id
2956 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2957 askfindhighlight $row $id
2959 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2960 askrelhighlight $row $id
2962 if {[info exists iddrawn($id)]} return
2963 set col [lsearch -exact [lindex $rowidlist $row] $id]
2965 puts "oops, row $row id $id not in list"
2968 if {![info exists commitinfo($id)]} {
2972 set olds [lindex $parentlist $row]
2974 set rmx [drawparentlinks $id $row $col $olds]
2978 drawcmittext $id $row $col $rmx
2982 proc drawfrac {f0 f1} {
2983 global numcommits canv
2986 set ymax [lindex [$canv cget -scrollregion] 3]
2987 if {$ymax eq {} || $ymax == 0} return
2988 set y0 [expr {int($f0 * $ymax)}]
2989 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2993 set y1 [expr {int($f1 * $ymax)}]
2994 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2995 if {$endrow >= $numcommits} {
2996 set endrow [expr {$numcommits - 1}]
2998 for {} {$row <= $endrow} {incr row} {
3003 proc drawvisible {} {
3005 eval drawfrac [$canv yview]
3008 proc clear_display {} {
3009 global iddrawn idrangedrawn
3010 global vhighlights fhighlights nhighlights rhighlights
3013 catch {unset iddrawn}
3014 catch {unset idrangedrawn}
3015 catch {unset vhighlights}
3016 catch {unset fhighlights}
3017 catch {unset nhighlights}
3018 catch {unset rhighlights}
3021 proc findcrossings {id} {
3022 global rowidlist parentlist numcommits rowoffsets displayorder
3026 foreach {s e} [rowranges $id] {
3027 if {$e >= $numcommits} {
3028 set e [expr {$numcommits - 1}]
3030 if {$e <= $s} continue
3031 set x [lsearch -exact [lindex $rowidlist $e] $id]
3033 puts "findcrossings: oops, no [shortids $id] in row $e"
3036 for {set row $e} {[incr row -1] >= $s} {} {
3037 set olds [lindex $parentlist $row]
3038 set kid [lindex $displayorder $row]
3039 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3040 if {$kidx < 0} continue
3041 set nextrow [lindex $rowidlist [expr {$row + 1}]]
3043 set px [lsearch -exact $nextrow $p]
3044 if {$px < 0} continue
3045 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3046 if {[lsearch -exact $ccross $p] >= 0} continue
3047 if {$x == $px + ($kidx < $px? -1: 1)} {
3049 } elseif {[lsearch -exact $cross $p] < 0} {
3054 set inc [lindex $rowoffsets $row $x]
3055 if {$inc eq {}} break
3059 return [concat $ccross {{}} $cross]
3062 proc assigncolor {id} {
3063 global colormap colors nextcolor
3064 global commitrow parentlist children children curview
3066 if {[info exists colormap($id)]} return
3067 set ncolors [llength $colors]
3068 if {[info exists children($curview,$id)]} {
3069 set kids $children($curview,$id)
3073 if {[llength $kids] == 1} {
3074 set child [lindex $kids 0]
3075 if {[info exists colormap($child)]
3076 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3077 set colormap($id) $colormap($child)
3083 foreach x [findcrossings $id] {
3085 # delimiter between corner crossings and other crossings
3086 if {[llength $badcolors] >= $ncolors - 1} break
3087 set origbad $badcolors
3089 if {[info exists colormap($x)]
3090 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3091 lappend badcolors $colormap($x)
3094 if {[llength $badcolors] >= $ncolors} {
3095 set badcolors $origbad
3097 set origbad $badcolors
3098 if {[llength $badcolors] < $ncolors - 1} {
3099 foreach child $kids {
3100 if {[info exists colormap($child)]
3101 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3102 lappend badcolors $colormap($child)
3104 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3105 if {[info exists colormap($p)]
3106 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3107 lappend badcolors $colormap($p)
3111 if {[llength $badcolors] >= $ncolors} {
3112 set badcolors $origbad
3115 for {set i 0} {$i <= $ncolors} {incr i} {
3116 set c [lindex $colors $nextcolor]
3117 if {[incr nextcolor] >= $ncolors} {
3120 if {[lsearch -exact $badcolors $c]} break
3122 set colormap($id) $c
3125 proc bindline {t id} {
3128 $canv bind $t <Enter> "lineenter %x %y $id"
3129 $canv bind $t <Motion> "linemotion %x %y $id"
3130 $canv bind $t <Leave> "lineleave $id"
3131 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3134 proc drawtags {id x xt y1} {
3135 global idtags idheads idotherrefs
3136 global linespc lthickness
3137 global canv mainfont commitrow rowtextx curview
3142 if {[info exists idtags($id)]} {
3143 set marks $idtags($id)
3144 set ntags [llength $marks]
3146 if {[info exists idheads($id)]} {
3147 set marks [concat $marks $idheads($id)]
3148 set nheads [llength $idheads($id)]
3150 if {[info exists idotherrefs($id)]} {
3151 set marks [concat $marks $idotherrefs($id)]
3157 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3158 set yt [expr {$y1 - 0.5 * $linespc}]
3159 set yb [expr {$yt + $linespc - 1}]
3162 foreach tag $marks {
3163 set wid [font measure $mainfont $tag]
3166 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3168 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3169 -width $lthickness -fill black -tags tag.$id]
3171 foreach tag $marks x $xvals wid $wvals {
3172 set xl [expr {$x + $delta}]
3173 set xr [expr {$x + $delta + $wid + $lthickness}]
3174 if {[incr ntags -1] >= 0} {
3176 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3177 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3178 -width 1 -outline black -fill yellow -tags tag.$id]
3179 $canv bind $t <1> [list showtag $tag 1]
3180 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3182 # draw a head or other ref
3183 if {[incr nheads -1] >= 0} {
3188 set xl [expr {$xl - $delta/2}]
3189 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3190 -width 1 -outline black -fill $col -tags tag.$id
3191 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3192 set rwid [font measure $mainfont $remoteprefix]
3193 set xi [expr {$x + 1}]
3194 set yti [expr {$yt + 1}]
3195 set xri [expr {$x + $rwid}]
3196 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3197 -width 0 -fill "#ffddaa" -tags tag.$id
3200 set t [$canv create text $xl $y1 -anchor w -text $tag \
3201 -font $mainfont -tags tag.$id]
3203 $canv bind $t <1> [list showtag $tag 1]
3209 proc xcoord {i level ln} {
3210 global canvx0 xspc1 xspc2
3212 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3213 if {$i > 0 && $i == $level} {
3214 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3215 } elseif {$i > $level} {
3216 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3221 proc show_status {msg} {
3222 global canv mainfont
3225 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
3228 proc finishcommits {} {
3229 global commitidx phase curview
3230 global canv mainfont ctext maincursor textcursor
3231 global findinprogress pending_select
3233 if {$commitidx($curview) > 0} {
3236 show_status "No commits selected"
3239 catch {unset pending_select}
3242 # Don't change the text pane cursor if it is currently the hand cursor,
3243 # showing that we are over a sha1 ID link.
3244 proc settextcursor {c} {
3245 global ctext curtextcursor
3247 if {[$ctext cget -cursor] == $curtextcursor} {
3248 $ctext config -cursor $c
3250 set curtextcursor $c
3253 proc nowbusy {what} {
3256 if {[array names isbusy] eq {}} {
3257 . config -cursor watch
3263 proc notbusy {what} {
3264 global isbusy maincursor textcursor
3266 catch {unset isbusy($what)}
3267 if {[array names isbusy] eq {}} {
3268 . config -cursor $maincursor
3269 settextcursor $textcursor
3276 global canvy0 numcommits linespc
3277 global rowlaidout commitidx curview
3278 global pending_select
3281 layoutrows $rowlaidout $commitidx($curview) 1
3283 optimize_rows $row 0 $commitidx($curview)
3284 showstuff $commitidx($curview)
3285 if {[info exists pending_select]} {
3289 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3290 #puts "overall $drawmsecs ms for $numcommits commits"
3293 proc findmatches {f} {
3294 global findtype foundstring foundstrlen
3295 if {$findtype == "Regexp"} {
3296 set matches [regexp -indices -all -inline $foundstring $f]
3298 if {$findtype == "IgnCase"} {
3299 set str [string tolower $f]
3305 while {[set j [string first $foundstring $str $i]] >= 0} {
3306 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3307 set i [expr {$j + $foundstrlen}]
3314 global findtype findloc findstring markedmatches commitinfo
3315 global numcommits displayorder linehtag linentag linedtag
3316 global mainfont canv canv2 canv3 selectedline
3317 global matchinglines foundstring foundstrlen matchstring
3322 cancel_next_highlight
3324 set matchinglines {}
3325 if {$findtype == "IgnCase"} {
3326 set foundstring [string tolower $findstring]
3328 set foundstring $findstring
3330 set foundstrlen [string length $findstring]
3331 if {$foundstrlen == 0} return
3332 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3333 set matchstring "*$matchstring*"
3334 if {![info exists selectedline]} {
3337 set oldsel $selectedline
3340 set fldtypes {Headline Author Date Committer CDate Comments}
3342 foreach id $displayorder {
3343 set d $commitdata($id)
3345 if {$findtype == "Regexp"} {
3346 set doesmatch [regexp $foundstring $d]
3347 } elseif {$findtype == "IgnCase"} {
3348 set doesmatch [string match -nocase $matchstring $d]
3350 set doesmatch [string match $matchstring $d]
3352 if {!$doesmatch} continue
3353 if {![info exists commitinfo($id)]} {
3356 set info $commitinfo($id)
3358 foreach f $info ty $fldtypes {
3359 if {$findloc != "All fields" && $findloc != $ty} {
3362 set matches [findmatches $f]
3363 if {$matches == {}} continue
3365 if {$ty == "Headline"} {
3367 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3368 } elseif {$ty == "Author"} {
3370 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3371 } elseif {$ty == "Date"} {
3373 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3377 lappend matchinglines $l
3378 if {!$didsel && $l > $oldsel} {
3384 if {$matchinglines == {}} {
3386 } elseif {!$didsel} {
3387 findselectline [lindex $matchinglines 0]
3391 proc findselectline {l} {
3392 global findloc commentend ctext
3394 if {$findloc == "All fields" || $findloc == "Comments"} {
3395 # highlight the matches in the comments
3396 set f [$ctext get 1.0 $commentend]
3397 set matches [findmatches $f]
3398 foreach match $matches {
3399 set start [lindex $match 0]
3400 set end [expr {[lindex $match 1] + 1}]
3401 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3406 proc findnext {restart} {
3407 global matchinglines selectedline
3408 if {![info exists matchinglines]} {
3414 if {![info exists selectedline]} return
3415 foreach l $matchinglines {
3416 if {$l > $selectedline} {
3425 global matchinglines selectedline
3426 if {![info exists matchinglines]} {
3430 if {![info exists selectedline]} return
3432 foreach l $matchinglines {
3433 if {$l >= $selectedline} break
3437 findselectline $prev
3443 proc stopfindproc {{done 0}} {
3444 global findprocpid findprocfile findids
3445 global ctext findoldcursor phase maincursor textcursor
3446 global findinprogress
3448 catch {unset findids}
3449 if {[info exists findprocpid]} {
3451 catch {exec kill $findprocpid}
3453 catch {close $findprocfile}
3456 catch {unset findinprogress}
3460 # mark a commit as matching by putting a yellow background
3461 # behind the headline
3462 proc markheadline {l id} {
3463 global canv mainfont linehtag
3466 set bbox [$canv bbox $linehtag($l)]
3467 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3471 # mark the bits of a headline, author or date that match a find string
3472 proc markmatches {canv l str tag matches font} {
3473 set bbox [$canv bbox $tag]
3474 set x0 [lindex $bbox 0]
3475 set y0 [lindex $bbox 1]
3476 set y1 [lindex $bbox 3]
3477 foreach match $matches {
3478 set start [lindex $match 0]
3479 set end [lindex $match 1]
3480 if {$start > $end} continue
3481 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3482 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3483 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3484 [expr {$x0+$xlen+2}] $y1 \
3485 -outline {} -tags matches -fill yellow]
3490 proc unmarkmatches {} {
3491 global matchinglines findids
3492 allcanvs delete matches
3493 catch {unset matchinglines}
3494 catch {unset findids}
3497 proc selcanvline {w x y} {
3498 global canv canvy0 ctext linespc
3500 set ymax [lindex [$canv cget -scrollregion] 3]
3501 if {$ymax == {}} return
3502 set yfrac [lindex [$canv yview] 0]
3503 set y [expr {$y + $yfrac * $ymax}]
3504 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3509 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3515 proc commit_descriptor {p} {
3517 if {![info exists commitinfo($p)]} {
3521 if {[llength $commitinfo($p)] > 1} {
3522 set l [lindex $commitinfo($p) 0]
3527 # append some text to the ctext widget, and make any SHA1 ID
3528 # that we know about be a clickable link.
3529 proc appendwithlinks {text} {
3530 global ctext commitrow linknum curview
3532 set start [$ctext index "end - 1c"]
3533 $ctext insert end $text
3534 $ctext insert end "\n"
3535 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3539 set linkid [string range $text $s $e]
3540 if {![info exists commitrow($curview,$linkid)]} continue
3542 $ctext tag add link "$start + $s c" "$start + $e c"
3543 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3544 $ctext tag bind link$linknum <1> \
3545 [list selectline $commitrow($curview,$linkid) 1]
3548 $ctext tag conf link -foreground blue -underline 1
3549 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3550 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3553 proc viewnextline {dir} {
3557 set ymax [lindex [$canv cget -scrollregion] 3]
3558 set wnow [$canv yview]
3559 set wtop [expr {[lindex $wnow 0] * $ymax}]
3560 set newtop [expr {$wtop + $dir * $linespc}]
3563 } elseif {$newtop > $ymax} {
3566 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3569 proc selectline {l isnew} {
3570 global canv canv2 canv3 ctext commitinfo selectedline
3571 global displayorder linehtag linentag linedtag
3572 global canvy0 linespc parentlist childlist
3573 global currentid sha1entry
3574 global commentend idtags linknum
3575 global mergemax numcommits pending_select
3578 catch {unset pending_select}
3581 cancel_next_highlight
3582 if {$l < 0 || $l >= $numcommits} return
3583 set y [expr {$canvy0 + $l * $linespc}]
3584 set ymax [lindex [$canv cget -scrollregion] 3]
3585 set ytop [expr {$y - $linespc - 1}]
3586 set ybot [expr {$y + $linespc + 1}]
3587 set wnow [$canv yview]
3588 set wtop [expr {[lindex $wnow 0] * $ymax}]
3589 set wbot [expr {[lindex $wnow 1] * $ymax}]
3590 set wh [expr {$wbot - $wtop}]
3592 if {$ytop < $wtop} {
3593 if {$ybot < $wtop} {
3594 set newtop [expr {$y - $wh / 2.0}]
3597 if {$newtop > $wtop - $linespc} {
3598 set newtop [expr {$wtop - $linespc}]
3601 } elseif {$ybot > $wbot} {
3602 if {$ytop > $wbot} {
3603 set newtop [expr {$y - $wh / 2.0}]
3605 set newtop [expr {$ybot - $wh}]
3606 if {$newtop < $wtop + $linespc} {
3607 set newtop [expr {$wtop + $linespc}]
3611 if {$newtop != $wtop} {
3615 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3619 if {![info exists linehtag($l)]} return
3621 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3622 -tags secsel -fill [$canv cget -selectbackground]]
3624 $canv2 delete secsel
3625 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3626 -tags secsel -fill [$canv2 cget -selectbackground]]
3628 $canv3 delete secsel
3629 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3630 -tags secsel -fill [$canv3 cget -selectbackground]]
3634 addtohistory [list selectline $l 0]
3639 set id [lindex $displayorder $l]
3641 $sha1entry delete 0 end
3642 $sha1entry insert 0 $id
3643 $sha1entry selection from 0
3644 $sha1entry selection to end
3647 $ctext conf -state normal
3650 set info $commitinfo($id)
3651 set date [formatdate [lindex $info 2]]
3652 $ctext insert end "Author: [lindex $info 1] $date\n"
3653 set date [formatdate [lindex $info 4]]
3654 $ctext insert end "Committer: [lindex $info 3] $date\n"
3655 if {[info exists idtags($id)]} {
3656 $ctext insert end "Tags:"
3657 foreach tag $idtags($id) {
3658 $ctext insert end " $tag"
3660 $ctext insert end "\n"
3664 set olds [lindex $parentlist $l]
3665 if {[llength $olds] > 1} {
3668 if {$np >= $mergemax} {
3673 $ctext insert end "Parent: " $tag
3674 appendwithlinks [commit_descriptor $p]
3679 append comment "Parent: [commit_descriptor $p]\n"
3683 foreach c [lindex $childlist $l] {
3684 append comment "Child: [commit_descriptor $c]\n"
3687 append comment [lindex $info 5]
3689 # make anything that looks like a SHA1 ID be a clickable link
3690 appendwithlinks $comment
3692 $ctext tag delete Comments
3693 $ctext tag remove found 1.0 end
3694 $ctext conf -state disabled
3695 set commentend [$ctext index "end - 1c"]
3697 init_flist "Comments"
3698 if {$cmitmode eq "tree"} {
3700 } elseif {[llength $olds] <= 1} {
3707 proc selfirstline {} {
3712 proc sellastline {} {
3715 set l [expr {$numcommits - 1}]
3719 proc selnextline {dir} {
3721 if {![info exists selectedline]} return
3722 set l [expr {$selectedline + $dir}]
3727 proc selnextpage {dir} {
3728 global canv linespc selectedline numcommits
3730 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3734 allcanvs yview scroll [expr {$dir * $lpp}] units
3736 if {![info exists selectedline]} return
3737 set l [expr {$selectedline + $dir * $lpp}]
3740 } elseif {$l >= $numcommits} {
3741 set l [expr $numcommits - 1]
3747 proc unselectline {} {
3748 global selectedline currentid
3750 catch {unset selectedline}
3751 catch {unset currentid}
3752 allcanvs delete secsel
3754 cancel_next_highlight
3757 proc reselectline {} {
3760 if {[info exists selectedline]} {
3761 selectline $selectedline 0
3765 proc addtohistory {cmd} {
3766 global history historyindex curview
3768 set elt [list $curview $cmd]
3769 if {$historyindex > 0
3770 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3774 if {$historyindex < [llength $history]} {
3775 set history [lreplace $history $historyindex end $elt]
3777 lappend history $elt
3780 if {$historyindex > 1} {
3781 .ctop.top.bar.leftbut conf -state normal
3783 .ctop.top.bar.leftbut conf -state disabled
3785 .ctop.top.bar.rightbut conf -state disabled
3791 set view [lindex $elt 0]
3792 set cmd [lindex $elt 1]
3793 if {$curview != $view} {
3800 global history historyindex
3802 if {$historyindex > 1} {
3803 incr historyindex -1
3804 godo [lindex $history [expr {$historyindex - 1}]]
3805 .ctop.top.bar.rightbut conf -state normal
3807 if {$historyindex <= 1} {
3808 .ctop.top.bar.leftbut conf -state disabled
3813 global history historyindex
3815 if {$historyindex < [llength $history]} {
3816 set cmd [lindex $history $historyindex]
3819 .ctop.top.bar.leftbut conf -state normal
3821 if {$historyindex >= [llength $history]} {
3822 .ctop.top.bar.rightbut conf -state disabled
3827 global treefilelist treeidlist diffids diffmergeid treepending
3830 catch {unset diffmergeid}
3831 if {![info exists treefilelist($id)]} {
3832 if {![info exists treepending]} {
3833 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3837 set treefilelist($id) {}
3838 set treeidlist($id) {}
3839 fconfigure $gtf -blocking 0
3840 fileevent $gtf readable [list gettreeline $gtf $id]
3847 proc gettreeline {gtf id} {
3848 global treefilelist treeidlist treepending cmitmode diffids
3850 while {[gets $gtf line] >= 0} {
3851 if {[lindex $line 1] ne "blob"} continue
3852 set sha1 [lindex $line 2]
3853 set fname [lindex $line 3]
3854 lappend treefilelist($id) $fname
3855 lappend treeidlist($id) $sha1
3857 if {![eof $gtf]} return
3860 if {$cmitmode ne "tree"} {
3861 if {![info exists diffmergeid]} {
3862 gettreediffs $diffids
3864 } elseif {$id ne $diffids} {
3872 global treefilelist treeidlist diffids
3873 global ctext commentend
3875 set i [lsearch -exact $treefilelist($diffids) $f]
3877 puts "oops, $f not in list for id $diffids"
3880 set blob [lindex $treeidlist($diffids) $i]
3881 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3882 puts "oops, error reading blob $blob: $err"
3885 fconfigure $bf -blocking 0
3886 fileevent $bf readable [list getblobline $bf $diffids]
3887 $ctext config -state normal
3888 clear_ctext $commentend
3889 $ctext insert end "\n"
3890 $ctext insert end "$f\n" filesep
3891 $ctext config -state disabled
3892 $ctext yview $commentend
3895 proc getblobline {bf id} {
3896 global diffids cmitmode ctext
3898 if {$id ne $diffids || $cmitmode ne "tree"} {
3902 $ctext config -state normal
3903 while {[gets $bf line] >= 0} {
3904 $ctext insert end "$line\n"
3907 # delete last newline
3908 $ctext delete "end - 2c" "end - 1c"
3911 $ctext config -state disabled
3914 proc mergediff {id l} {
3915 global diffmergeid diffopts mdifffd
3921 # this doesn't seem to actually affect anything...
3922 set env(GIT_DIFF_OPTS) $diffopts
3923 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3924 if {[catch {set mdf [open $cmd r]} err]} {
3925 error_popup "Error getting merge diffs: $err"
3928 fconfigure $mdf -blocking 0
3929 set mdifffd($id) $mdf
3930 set np [llength [lindex $parentlist $l]]
3931 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3932 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3935 proc getmergediffline {mdf id np} {
3936 global diffmergeid ctext cflist nextupdate mergemax
3937 global difffilestart mdifffd
3939 set n [gets $mdf line]
3946 if {![info exists diffmergeid] || $id != $diffmergeid
3947 || $mdf != $mdifffd($id)} {
3950 $ctext conf -state normal
3951 if {[regexp {^diff --cc (.*)} $line match fname]} {
3952 # start of a new file
3953 $ctext insert end "\n"
3954 set here [$ctext index "end - 1c"]
3955 lappend difffilestart $here
3956 add_flist [list $fname]
3957 set l [expr {(78 - [string length $fname]) / 2}]
3958 set pad [string range "----------------------------------------" 1 $l]
3959 $ctext insert end "$pad $fname $pad\n" filesep
3960 } elseif {[regexp {^@@} $line]} {
3961 $ctext insert end "$line\n" hunksep
3962 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3965 # parse the prefix - one ' ', '-' or '+' for each parent
3970 for {set j 0} {$j < $np} {incr j} {
3971 set c [string range $line $j $j]
3974 } elseif {$c == "-"} {
3976 } elseif {$c == "+"} {
3985 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3986 # line doesn't appear in result, parents in $minuses have the line
3987 set num [lindex $minuses 0]
3988 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3989 # line appears in result, parents in $pluses don't have the line
3990 lappend tags mresult
3991 set num [lindex $spaces 0]
3994 if {$num >= $mergemax} {
3999 $ctext insert end "$line\n" $tags
4001 $ctext conf -state disabled
4002 if {[clock clicks -milliseconds] >= $nextupdate} {
4004 fileevent $mdf readable {}
4006 fileevent $mdf readable [list getmergediffline $mdf $id $np]
4010 proc startdiff {ids} {
4011 global treediffs diffids treepending diffmergeid
4014 catch {unset diffmergeid}
4015 if {![info exists treediffs($ids)]} {
4016 if {![info exists treepending]} {
4024 proc addtocflist {ids} {
4025 global treediffs cflist
4026 add_flist $treediffs($ids)
4030 proc gettreediffs {ids} {
4031 global treediff treepending
4032 set treepending $ids
4035 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
4037 fconfigure $gdtf -blocking 0
4038 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4041 proc gettreediffline {gdtf ids} {
4042 global treediff treediffs treepending diffids diffmergeid
4045 set n [gets $gdtf line]
4047 if {![eof $gdtf]} return
4049 set treediffs($ids) $treediff
4051 if {$cmitmode eq "tree"} {
4053 } elseif {$ids != $diffids} {
4054 if {![info exists diffmergeid]} {
4055 gettreediffs $diffids
4062 set file [lindex $line 5]
4063 lappend treediff $file
4066 proc getblobdiffs {ids} {
4067 global diffopts blobdifffd diffids env curdifftag curtagstart
4068 global nextupdate diffinhdr treediffs
4070 set env(GIT_DIFF_OPTS) $diffopts
4071 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
4072 if {[catch {set bdf [open $cmd r]} err]} {
4073 puts "error getting diffs: $err"
4077 fconfigure $bdf -blocking 0
4078 set blobdifffd($ids) $bdf
4079 set curdifftag Comments
4081 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4082 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4085 proc setinlist {var i val} {
4088 while {[llength [set $var]] < $i} {
4091 if {[llength [set $var]] == $i} {
4098 proc getblobdiffline {bdf ids} {
4099 global diffids blobdifffd ctext curdifftag curtagstart
4100 global diffnexthead diffnextnote difffilestart
4101 global nextupdate diffinhdr treediffs
4103 set n [gets $bdf line]
4107 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4108 $ctext tag add $curdifftag $curtagstart end
4113 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4116 $ctext conf -state normal
4117 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4118 # start of a new file
4119 $ctext insert end "\n"
4120 $ctext tag add $curdifftag $curtagstart end
4121 set here [$ctext index "end - 1c"]
4122 set curtagstart $here
4124 set i [lsearch -exact $treediffs($ids) $fname]
4126 setinlist difffilestart $i $here
4128 if {$newname ne $fname} {
4129 set i [lsearch -exact $treediffs($ids) $newname]
4131 setinlist difffilestart $i $here
4134 set curdifftag "f:$fname"
4135 $ctext tag delete $curdifftag
4136 set l [expr {(78 - [string length $header]) / 2}]
4137 set pad [string range "----------------------------------------" 1 $l]
4138 $ctext insert end "$pad $header $pad\n" filesep
4140 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4142 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4144 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4145 $line match f1l f1c f2l f2c rest]} {
4146 $ctext insert end "$line\n" hunksep
4149 set x [string range $line 0 0]
4150 if {$x == "-" || $x == "+"} {
4151 set tag [expr {$x == "+"}]
4152 $ctext insert end "$line\n" d$tag
4153 } elseif {$x == " "} {
4154 $ctext insert end "$line\n"
4155 } elseif {$diffinhdr || $x == "\\"} {
4156 # e.g. "\ No newline at end of file"
4157 $ctext insert end "$line\n" filesep
4159 # Something else we don't recognize
4160 if {$curdifftag != "Comments"} {
4161 $ctext insert end "\n"
4162 $ctext tag add $curdifftag $curtagstart end
4163 set curtagstart [$ctext index "end - 1c"]
4164 set curdifftag Comments
4166 $ctext insert end "$line\n" filesep
4169 $ctext conf -state disabled
4170 if {[clock clicks -milliseconds] >= $nextupdate} {
4172 fileevent $bdf readable {}
4174 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4179 global difffilestart ctext
4180 set here [$ctext index @0,0]
4181 foreach loc $difffilestart {
4182 if {[$ctext compare $loc > $here]} {
4188 proc clear_ctext {{first 1.0}} {
4189 global ctext smarktop smarkbot
4191 set l [lindex [split $first .] 0]
4192 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4195 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4198 $ctext delete $first end
4201 proc incrsearch {name ix op} {
4202 global ctext searchstring searchdirn
4204 $ctext tag remove found 1.0 end
4205 if {[catch {$ctext index anchor}]} {
4206 # no anchor set, use start of selection, or of visible area
4207 set sel [$ctext tag ranges sel]
4209 $ctext mark set anchor [lindex $sel 0]
4210 } elseif {$searchdirn eq "-forwards"} {
4211 $ctext mark set anchor @0,0
4213 $ctext mark set anchor @0,[winfo height $ctext]
4216 if {$searchstring ne {}} {
4217 set here [$ctext search $searchdirn -- $searchstring anchor]
4226 global sstring ctext searchstring searchdirn
4229 $sstring icursor end
4230 set searchdirn -forwards
4231 if {$searchstring ne {}} {
4232 set sel [$ctext tag ranges sel]
4234 set start "[lindex $sel 0] + 1c"
4235 } elseif {[catch {set start [$ctext index anchor]}]} {
4238 set match [$ctext search -count mlen -- $searchstring $start]
4239 $ctext tag remove sel 1.0 end
4245 set mend "$match + $mlen c"
4246 $ctext tag add sel $match $mend
4247 $ctext mark unset anchor
4251 proc dosearchback {} {
4252 global sstring ctext searchstring searchdirn
4255 $sstring icursor end
4256 set searchdirn -backwards
4257 if {$searchstring ne {}} {
4258 set sel [$ctext tag ranges sel]
4260 set start [lindex $sel 0]
4261 } elseif {[catch {set start [$ctext index anchor]}]} {
4262 set start @0,[winfo height $ctext]
4264 set match [$ctext search -backwards -count ml -- $searchstring $start]
4265 $ctext tag remove sel 1.0 end
4271 set mend "$match + $ml c"
4272 $ctext tag add sel $match $mend
4273 $ctext mark unset anchor
4277 proc searchmark {first last} {
4278 global ctext searchstring
4282 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4283 if {$match eq {}} break
4284 set mend "$match + $mlen c"
4285 $ctext tag add found $match $mend
4289 proc searchmarkvisible {doall} {
4290 global ctext smarktop smarkbot
4292 set topline [lindex [split [$ctext index @0,0] .] 0]
4293 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4294 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4295 # no overlap with previous
4296 searchmark $topline $botline
4297 set smarktop $topline
4298 set smarkbot $botline
4300 if {$topline < $smarktop} {
4301 searchmark $topline [expr {$smarktop-1}]
4302 set smarktop $topline
4304 if {$botline > $smarkbot} {
4305 searchmark [expr {$smarkbot+1}] $botline
4306 set smarkbot $botline
4311 proc scrolltext {f0 f1} {
4314 .ctop.cdet.left.sb set $f0 $f1
4315 if {$searchstring ne {}} {
4321 global linespc charspc canvx0 canvy0 mainfont
4322 global xspc1 xspc2 lthickness
4324 set linespc [font metrics $mainfont -linespace]
4325 set charspc [font measure $mainfont "m"]
4326 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4327 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4328 set lthickness [expr {int($linespc / 9) + 1}]
4329 set xspc1(0) $linespc
4337 set ymax [lindex [$canv cget -scrollregion] 3]
4338 if {$ymax eq {} || $ymax == 0} return
4339 set span [$canv yview]
4342 allcanvs yview moveto [lindex $span 0]
4344 if {[info exists selectedline]} {
4345 selectline $selectedline 0
4349 proc incrfont {inc} {
4350 global mainfont textfont ctext canv phase
4351 global stopped entries
4353 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4354 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4356 $ctext conf -font $textfont
4357 $ctext tag conf filesep -font [concat $textfont bold]
4358 foreach e $entries {
4359 $e conf -font $mainfont
4361 if {$phase eq "getcommits"} {
4362 $canv itemconf textitems -font $mainfont
4368 global sha1entry sha1string
4369 if {[string length $sha1string] == 40} {
4370 $sha1entry delete 0 end
4374 proc sha1change {n1 n2 op} {
4375 global sha1string currentid sha1but
4376 if {$sha1string == {}
4377 || ([info exists currentid] && $sha1string == $currentid)} {
4382 if {[$sha1but cget -state] == $state} return
4383 if {$state == "normal"} {
4384 $sha1but conf -state normal -relief raised -text "Goto: "
4386 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4390 proc gotocommit {} {
4391 global sha1string currentid commitrow tagids headids
4392 global displayorder numcommits curview
4394 if {$sha1string == {}
4395 || ([info exists currentid] && $sha1string == $currentid)} return
4396 if {[info exists tagids($sha1string)]} {
4397 set id $tagids($sha1string)
4398 } elseif {[info exists headids($sha1string)]} {
4399 set id $headids($sha1string)
4401 set id [string tolower $sha1string]
4402 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4404 foreach i $displayorder {
4405 if {[string match $id* $i]} {
4409 if {$matches ne {}} {
4410 if {[llength $matches] > 1} {
4411 error_popup "Short SHA1 id $id is ambiguous"
4414 set id [lindex $matches 0]
4418 if {[info exists commitrow($curview,$id)]} {
4419 selectline $commitrow($curview,$id) 1
4422 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4427 error_popup "$type $sha1string is not known"
4430 proc lineenter {x y id} {
4431 global hoverx hovery hoverid hovertimer
4432 global commitinfo canv
4434 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4438 if {[info exists hovertimer]} {
4439 after cancel $hovertimer
4441 set hovertimer [after 500 linehover]
4445 proc linemotion {x y id} {
4446 global hoverx hovery hoverid hovertimer
4448 if {[info exists hoverid] && $id == $hoverid} {
4451 if {[info exists hovertimer]} {
4452 after cancel $hovertimer
4454 set hovertimer [after 500 linehover]
4458 proc lineleave {id} {
4459 global hoverid hovertimer canv
4461 if {[info exists hoverid] && $id == $hoverid} {
4463 if {[info exists hovertimer]} {
4464 after cancel $hovertimer
4472 global hoverx hovery hoverid hovertimer
4473 global canv linespc lthickness
4474 global commitinfo mainfont
4476 set text [lindex $commitinfo($hoverid) 0]
4477 set ymax [lindex [$canv cget -scrollregion] 3]
4478 if {$ymax == {}} return
4479 set yfrac [lindex [$canv yview] 0]
4480 set x [expr {$hoverx + 2 * $linespc}]
4481 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4482 set x0 [expr {$x - 2 * $lthickness}]
4483 set y0 [expr {$y - 2 * $lthickness}]
4484 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4485 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4486 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4487 -fill \#ffff80 -outline black -width 1 -tags hover]
4489 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4493 proc clickisonarrow {id y} {
4496 set ranges [rowranges $id]
4497 set thresh [expr {2 * $lthickness + 6}]
4498 set n [expr {[llength $ranges] - 1}]
4499 for {set i 1} {$i < $n} {incr i} {
4500 set row [lindex $ranges $i]
4501 if {abs([yc $row] - $y) < $thresh} {
4508 proc arrowjump {id n y} {
4511 # 1 <-> 2, 3 <-> 4, etc...
4512 set n [expr {(($n - 1) ^ 1) + 1}]
4513 set row [lindex [rowranges $id] $n]
4515 set ymax [lindex [$canv cget -scrollregion] 3]
4516 if {$ymax eq {} || $ymax <= 0} return
4517 set view [$canv yview]
4518 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4519 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4523 allcanvs yview moveto $yfrac
4526 proc lineclick {x y id isnew} {
4527 global ctext commitinfo children canv thickerline curview
4529 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4534 # draw this line thicker than normal
4538 set ymax [lindex [$canv cget -scrollregion] 3]
4539 if {$ymax eq {}} return
4540 set yfrac [lindex [$canv yview] 0]
4541 set y [expr {$y + $yfrac * $ymax}]
4543 set dirn [clickisonarrow $id $y]
4545 arrowjump $id $dirn $y
4550 addtohistory [list lineclick $x $y $id 0]
4552 # fill the details pane with info about this line
4553 $ctext conf -state normal
4555 $ctext tag conf link -foreground blue -underline 1
4556 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4557 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4558 $ctext insert end "Parent:\t"
4559 $ctext insert end $id [list link link0]
4560 $ctext tag bind link0 <1> [list selbyid $id]
4561 set info $commitinfo($id)
4562 $ctext insert end "\n\t[lindex $info 0]\n"
4563 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4564 set date [formatdate [lindex $info 2]]
4565 $ctext insert end "\tDate:\t$date\n"
4566 set kids $children($curview,$id)
4568 $ctext insert end "\nChildren:"
4570 foreach child $kids {
4572 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4573 set info $commitinfo($child)
4574 $ctext insert end "\n\t"
4575 $ctext insert end $child [list link link$i]
4576 $ctext tag bind link$i <1> [list selbyid $child]
4577 $ctext insert end "\n\t[lindex $info 0]"
4578 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4579 set date [formatdate [lindex $info 2]]
4580 $ctext insert end "\n\tDate:\t$date\n"
4583 $ctext conf -state disabled
4587 proc normalline {} {
4589 if {[info exists thickerline]} {
4597 global commitrow curview
4598 if {[info exists commitrow($curview,$id)]} {
4599 selectline $commitrow($curview,$id) 1
4605 if {![info exists startmstime]} {
4606 set startmstime [clock clicks -milliseconds]
4608 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4611 proc rowmenu {x y id} {
4612 global rowctxmenu commitrow selectedline rowmenuid curview
4614 if {![info exists selectedline]
4615 || $commitrow($curview,$id) eq $selectedline} {
4620 $rowctxmenu entryconfigure 0 -state $state
4621 $rowctxmenu entryconfigure 1 -state $state
4622 $rowctxmenu entryconfigure 2 -state $state
4624 tk_popup $rowctxmenu $x $y
4627 proc diffvssel {dirn} {
4628 global rowmenuid selectedline displayorder
4630 if {![info exists selectedline]} return
4632 set oldid [lindex $displayorder $selectedline]
4633 set newid $rowmenuid
4635 set oldid $rowmenuid
4636 set newid [lindex $displayorder $selectedline]
4638 addtohistory [list doseldiff $oldid $newid]
4639 doseldiff $oldid $newid
4642 proc doseldiff {oldid newid} {
4646 $ctext conf -state normal
4649 $ctext insert end "From "
4650 $ctext tag conf link -foreground blue -underline 1
4651 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4652 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4653 $ctext tag bind link0 <1> [list selbyid $oldid]
4654 $ctext insert end $oldid [list link link0]
4655 $ctext insert end "\n "
4656 $ctext insert end [lindex $commitinfo($oldid) 0]
4657 $ctext insert end "\n\nTo "
4658 $ctext tag bind link1 <1> [list selbyid $newid]
4659 $ctext insert end $newid [list link link1]
4660 $ctext insert end "\n "
4661 $ctext insert end [lindex $commitinfo($newid) 0]
4662 $ctext insert end "\n"
4663 $ctext conf -state disabled
4664 $ctext tag delete Comments
4665 $ctext tag remove found 1.0 end
4666 startdiff [list $oldid $newid]
4670 global rowmenuid currentid commitinfo patchtop patchnum
4672 if {![info exists currentid]} return
4673 set oldid $currentid
4674 set oldhead [lindex $commitinfo($oldid) 0]
4675 set newid $rowmenuid
4676 set newhead [lindex $commitinfo($newid) 0]
4679 catch {destroy $top}
4681 label $top.title -text "Generate patch"
4682 grid $top.title - -pady 10
4683 label $top.from -text "From:"
4684 entry $top.fromsha1 -width 40 -relief flat
4685 $top.fromsha1 insert 0 $oldid
4686 $top.fromsha1 conf -state readonly
4687 grid $top.from $top.fromsha1 -sticky w
4688 entry $top.fromhead -width 60 -relief flat
4689 $top.fromhead insert 0 $oldhead
4690 $top.fromhead conf -state readonly
4691 grid x $top.fromhead -sticky w
4692 label $top.to -text "To:"
4693 entry $top.tosha1 -width 40 -relief flat
4694 $top.tosha1 insert 0 $newid
4695 $top.tosha1 conf -state readonly
4696 grid $top.to $top.tosha1 -sticky w
4697 entry $top.tohead -width 60 -relief flat
4698 $top.tohead insert 0 $newhead
4699 $top.tohead conf -state readonly
4700 grid x $top.tohead -sticky w
4701 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4702 grid $top.rev x -pady 10
4703 label $top.flab -text "Output file:"
4704 entry $top.fname -width 60
4705 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4707 grid $top.flab $top.fname -sticky w
4709 button $top.buts.gen -text "Generate" -command mkpatchgo
4710 button $top.buts.can -text "Cancel" -command mkpatchcan
4711 grid $top.buts.gen $top.buts.can
4712 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4713 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4714 grid $top.buts - -pady 10 -sticky ew
4718 proc mkpatchrev {} {
4721 set oldid [$patchtop.fromsha1 get]
4722 set oldhead [$patchtop.fromhead get]
4723 set newid [$patchtop.tosha1 get]
4724 set newhead [$patchtop.tohead get]
4725 foreach e [list fromsha1 fromhead tosha1 tohead] \
4726 v [list $newid $newhead $oldid $oldhead] {
4727 $patchtop.$e conf -state normal
4728 $patchtop.$e delete 0 end
4729 $patchtop.$e insert 0 $v
4730 $patchtop.$e conf -state readonly
4737 set oldid [$patchtop.fromsha1 get]
4738 set newid [$patchtop.tosha1 get]
4739 set fname [$patchtop.fname get]
4740 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4741 error_popup "Error creating patch: $err"
4743 catch {destroy $patchtop}
4747 proc mkpatchcan {} {
4750 catch {destroy $patchtop}
4755 global rowmenuid mktagtop commitinfo
4759 catch {destroy $top}
4761 label $top.title -text "Create tag"
4762 grid $top.title - -pady 10
4763 label $top.id -text "ID:"
4764 entry $top.sha1 -width 40 -relief flat
4765 $top.sha1 insert 0 $rowmenuid
4766 $top.sha1 conf -state readonly
4767 grid $top.id $top.sha1 -sticky w
4768 entry $top.head -width 60 -relief flat
4769 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4770 $top.head conf -state readonly
4771 grid x $top.head -sticky w
4772 label $top.tlab -text "Tag name:"
4773 entry $top.tag -width 60
4774 grid $top.tlab $top.tag -sticky w
4776 button $top.buts.gen -text "Create" -command mktaggo
4777 button $top.buts.can -text "Cancel" -command mktagcan
4778 grid $top.buts.gen $top.buts.can
4779 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4780 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4781 grid $top.buts - -pady 10 -sticky ew
4786 global mktagtop env tagids idtags
4788 set id [$mktagtop.sha1 get]
4789 set tag [$mktagtop.tag get]
4791 error_popup "No tag name specified"
4794 if {[info exists tagids($tag)]} {
4795 error_popup "Tag \"$tag\" already exists"
4800 set fname [file join $dir "refs/tags" $tag]
4801 set f [open $fname w]
4805 error_popup "Error creating tag: $err"
4809 set tagids($tag) $id
4810 lappend idtags($id) $tag
4814 proc redrawtags {id} {
4815 global canv linehtag commitrow idpos selectedline curview
4817 if {![info exists commitrow($curview,$id)]} return
4818 drawcmitrow $commitrow($curview,$id)
4819 $canv delete tag.$id
4820 set xt [eval drawtags $id $idpos($id)]
4821 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4822 if {[info exists selectedline]
4823 && $selectedline == $commitrow($curview,$id)} {
4824 selectline $selectedline 0
4831 catch {destroy $mktagtop}
4840 proc writecommit {} {
4841 global rowmenuid wrcomtop commitinfo wrcomcmd
4843 set top .writecommit
4845 catch {destroy $top}
4847 label $top.title -text "Write commit to file"
4848 grid $top.title - -pady 10
4849 label $top.id -text "ID:"
4850 entry $top.sha1 -width 40 -relief flat
4851 $top.sha1 insert 0 $rowmenuid
4852 $top.sha1 conf -state readonly
4853 grid $top.id $top.sha1 -sticky w
4854 entry $top.head -width 60 -relief flat
4855 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4856 $top.head conf -state readonly
4857 grid x $top.head -sticky w
4858 label $top.clab -text "Command:"
4859 entry $top.cmd -width 60 -textvariable wrcomcmd
4860 grid $top.clab $top.cmd -sticky w -pady 10
4861 label $top.flab -text "Output file:"
4862 entry $top.fname -width 60
4863 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4864 grid $top.flab $top.fname -sticky w
4866 button $top.buts.gen -text "Write" -command wrcomgo
4867 button $top.buts.can -text "Cancel" -command wrcomcan
4868 grid $top.buts.gen $top.buts.can
4869 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4870 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4871 grid $top.buts - -pady 10 -sticky ew
4878 set id [$wrcomtop.sha1 get]
4879 set cmd "echo $id | [$wrcomtop.cmd get]"
4880 set fname [$wrcomtop.fname get]
4881 if {[catch {exec sh -c $cmd >$fname &} err]} {
4882 error_popup "Error writing commit: $err"
4884 catch {destroy $wrcomtop}
4891 catch {destroy $wrcomtop}
4895 proc listrefs {id} {
4896 global idtags idheads idotherrefs
4899 if {[info exists idtags($id)]} {
4903 if {[info exists idheads($id)]} {
4907 if {[info exists idotherrefs($id)]} {
4908 set z $idotherrefs($id)
4910 return [list $x $y $z]
4913 proc rereadrefs {} {
4914 global idtags idheads idotherrefs
4916 set refids [concat [array names idtags] \
4917 [array names idheads] [array names idotherrefs]]
4918 foreach id $refids {
4919 if {![info exists ref($id)]} {
4920 set ref($id) [listrefs $id]
4924 set refids [lsort -unique [concat $refids [array names idtags] \
4925 [array names idheads] [array names idotherrefs]]]
4926 foreach id $refids {
4927 set v [listrefs $id]
4928 if {![info exists ref($id)] || $ref($id) != $v} {
4934 proc showtag {tag isnew} {
4935 global ctext tagcontents tagids linknum
4938 addtohistory [list showtag $tag 0]
4940 $ctext conf -state normal
4943 if {[info exists tagcontents($tag)]} {
4944 set text $tagcontents($tag)
4946 set text "Tag: $tag\nId: $tagids($tag)"
4948 appendwithlinks $text
4949 $ctext conf -state disabled
4960 global maxwidth maxgraphpct diffopts
4961 global oldprefs prefstop
4965 if {[winfo exists $top]} {
4969 foreach v {maxwidth maxgraphpct diffopts} {
4970 set oldprefs($v) [set $v]
4973 wm title $top "Gitk preferences"
4974 label $top.ldisp -text "Commit list display options"
4975 grid $top.ldisp - -sticky w -pady 10
4976 label $top.spacer -text " "
4977 label $top.maxwidthl -text "Maximum graph width (lines)" \
4979 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4980 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4981 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4983 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4984 grid x $top.maxpctl $top.maxpct -sticky w
4985 label $top.ddisp -text "Diff display options"
4986 grid $top.ddisp - -sticky w -pady 10
4987 label $top.diffoptl -text "Options for diff program" \
4989 entry $top.diffopt -width 20 -textvariable diffopts
4990 grid x $top.diffoptl $top.diffopt -sticky w
4992 button $top.buts.ok -text "OK" -command prefsok
4993 button $top.buts.can -text "Cancel" -command prefscan
4994 grid $top.buts.ok $top.buts.can
4995 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4996 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4997 grid $top.buts - - -pady 10 -sticky ew
5001 global maxwidth maxgraphpct diffopts
5002 global oldprefs prefstop
5004 foreach v {maxwidth maxgraphpct diffopts} {
5005 set $v $oldprefs($v)
5007 catch {destroy $prefstop}
5012 global maxwidth maxgraphpct
5013 global oldprefs prefstop
5015 catch {destroy $prefstop}
5017 if {$maxwidth != $oldprefs(maxwidth)
5018 || $maxgraphpct != $oldprefs(maxgraphpct)} {
5023 proc formatdate {d} {
5024 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5027 # This list of encoding names and aliases is distilled from
5028 # http://www.iana.org/assignments/character-sets.
5029 # Not all of them are supported by Tcl.
5030 set encoding_aliases {
5031 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5032 ISO646-US US-ASCII us IBM367 cp367 csASCII }
5033 { ISO-10646-UTF-1 csISO10646UTF1 }
5034 { ISO_646.basic:1983 ref csISO646basic1983 }
5035 { INVARIANT csINVARIANT }
5036 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5037 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5038 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5039 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5040 { NATS-DANO iso-ir-9-1 csNATSDANO }
5041 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5042 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5043 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5044 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5045 { ISO-2022-KR csISO2022KR }
5047 { ISO-2022-JP csISO2022JP }
5048 { ISO-2022-JP-2 csISO2022JP2 }
5049 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5051 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5052 { IT iso-ir-15 ISO646-IT csISO15Italian }
5053 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5054 { ES iso-ir-17 ISO646-ES csISO17Spanish }
5055 { greek7-old iso-ir-18 csISO18Greek7Old }
5056 { latin-greek iso-ir-19 csISO19LatinGreek }
5057 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5058 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5059 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5060 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5061 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5062 { BS_viewdata iso-ir-47 csISO47BSViewdata }
5063 { INIS iso-ir-49 csISO49INIS }
5064 { INIS-8 iso-ir-50 csISO50INIS8 }
5065 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5066 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5067 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5068 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5069 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5070 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5072 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5073 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5074 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5075 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5076 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5077 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5078 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5079 { greek7 iso-ir-88 csISO88Greek7 }
5080 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5081 { iso-ir-90 csISO90 }
5082 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5083 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5084 csISO92JISC62991984b }
5085 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5086 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5087 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5088 csISO95JIS62291984handadd }
5089 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5090 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5091 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5092 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5094 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5095 { T.61-7bit iso-ir-102 csISO102T617bit }
5096 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5097 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5098 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5099 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5100 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5101 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5102 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5103 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5104 arabic csISOLatinArabic }
5105 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5106 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5107 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5108 greek greek8 csISOLatinGreek }
5109 { T.101-G2 iso-ir-128 csISO128T101G2 }
5110 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5112 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5113 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5114 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5115 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5116 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5117 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5118 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5119 csISOLatinCyrillic }
5120 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5121 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5122 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5123 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5124 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5125 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5126 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5127 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5128 { ISO_10367-box iso-ir-155 csISO10367Box }
5129 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5130 { latin-lap lap iso-ir-158 csISO158Lap }
5131 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5132 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5135 { JIS_X0201 X0201 csHalfWidthKatakana }
5136 { KSC5636 ISO646-KR csKSC5636 }
5137 { ISO-10646-UCS-2 csUnicode }
5138 { ISO-10646-UCS-4 csUCS4 }
5139 { DEC-MCS dec csDECMCS }
5140 { hp-roman8 roman8 r8 csHPRoman8 }
5141 { macintosh mac csMacintosh }
5142 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5144 { IBM038 EBCDIC-INT cp038 csIBM038 }
5145 { IBM273 CP273 csIBM273 }
5146 { IBM274 EBCDIC-BE CP274 csIBM274 }
5147 { IBM275 EBCDIC-BR cp275 csIBM275 }
5148 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5149 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5150 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5151 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5152 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5153 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5154 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5155 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5156 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5157 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5158 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5159 { IBM437 cp437 437 csPC8CodePage437 }
5160 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5161 { IBM775 cp775 csPC775Baltic }
5162 { IBM850 cp850 850 csPC850Multilingual }
5163 { IBM851 cp851 851 csIBM851 }
5164 { IBM852 cp852 852 csPCp852 }
5165 { IBM855 cp855 855 csIBM855 }
5166 { IBM857 cp857 857 csIBM857 }
5167 { IBM860 cp860 860 csIBM860 }
5168 { IBM861 cp861 861 cp-is csIBM861 }
5169 { IBM862 cp862 862 csPC862LatinHebrew }
5170 { IBM863 cp863 863 csIBM863 }
5171 { IBM864 cp864 csIBM864 }
5172 { IBM865 cp865 865 csIBM865 }
5173 { IBM866 cp866 866 csIBM866 }
5174 { IBM868 CP868 cp-ar csIBM868 }
5175 { IBM869 cp869 869 cp-gr csIBM869 }
5176 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5177 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5178 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5179 { IBM891 cp891 csIBM891 }
5180 { IBM903 cp903 csIBM903 }
5181 { IBM904 cp904 904 csIBBM904 }
5182 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5183 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5184 { IBM1026 CP1026 csIBM1026 }
5185 { EBCDIC-AT-DE csIBMEBCDICATDE }
5186 { EBCDIC-AT-DE-A csEBCDICATDEA }
5187 { EBCDIC-CA-FR csEBCDICCAFR }
5188 { EBCDIC-DK-NO csEBCDICDKNO }
5189 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5190 { EBCDIC-FI-SE csEBCDICFISE }
5191 { EBCDIC-FI-SE-A csEBCDICFISEA }
5192 { EBCDIC-FR csEBCDICFR }
5193 { EBCDIC-IT csEBCDICIT }
5194 { EBCDIC-PT csEBCDICPT }
5195 { EBCDIC-ES csEBCDICES }
5196 { EBCDIC-ES-A csEBCDICESA }
5197 { EBCDIC-ES-S csEBCDICESS }
5198 { EBCDIC-UK csEBCDICUK }
5199 { EBCDIC-US csEBCDICUS }
5200 { UNKNOWN-8BIT csUnknown8BiT }
5201 { MNEMONIC csMnemonic }
5206 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5207 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5208 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5209 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5210 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5211 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5212 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5213 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5214 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5215 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5216 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5217 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5218 { IBM1047 IBM-1047 }
5219 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5220 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5221 { UNICODE-1-1 csUnicode11 }
5224 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5225 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5227 { ISO-8859-15 ISO_8859-15 Latin-9 }
5228 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5229 { GBK CP936 MS936 windows-936 }
5230 { JIS_Encoding csJISEncoding }
5231 { Shift_JIS MS_Kanji csShiftJIS }
5232 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5234 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5235 { ISO-10646-UCS-Basic csUnicodeASCII }
5236 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5237 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5238 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5239 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5240 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5241 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5242 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5243 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5244 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5245 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5246 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5247 { Ventura-US csVenturaUS }
5248 { Ventura-International csVenturaInternational }
5249 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5250 { PC8-Turkish csPC8Turkish }
5251 { IBM-Symbols csIBMSymbols }
5252 { IBM-Thai csIBMThai }
5253 { HP-Legal csHPLegal }
5254 { HP-Pi-font csHPPiFont }
5255 { HP-Math8 csHPMath8 }
5256 { Adobe-Symbol-Encoding csHPPSMath }
5257 { HP-DeskTop csHPDesktop }
5258 { Ventura-Math csVenturaMath }
5259 { Microsoft-Publishing csMicrosoftPublishing }
5260 { Windows-31J csWindows31J }
5265 proc tcl_encoding {enc} {
5266 global encoding_aliases
5267 set names [encoding names]
5268 set lcnames [string tolower $names]
5269 set enc [string tolower $enc]
5270 set i [lsearch -exact $lcnames $enc]
5272 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5273 if {[regsub {^iso[-_]} $enc iso encx]} {
5274 set i [lsearch -exact $lcnames $encx]
5278 foreach l $encoding_aliases {
5279 set ll [string tolower $l]
5280 if {[lsearch -exact $ll $enc] < 0} continue
5281 # look through the aliases for one that tcl knows about
5283 set i [lsearch -exact $lcnames $e]
5285 if {[regsub {^iso[-_]} $e iso ex]} {
5286 set i [lsearch -exact $lcnames $ex]
5295 return [lindex $names $i]
5302 set diffopts "-U 5 -p"
5303 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5307 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5309 if {$gitencoding == ""} {
5310 set gitencoding "utf-8"
5312 set tclencoding [tcl_encoding $gitencoding]
5313 if {$tclencoding == {}} {
5314 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5317 set mainfont {Helvetica 9}
5318 set textfont {Courier 9}
5319 set uifont {Helvetica 9 bold}
5320 set findmergefiles 0
5328 set cmitmode "patch"
5330 set colors {green red blue magenta darkgrey brown orange}
5332 catch {source ~/.gitk}
5334 font create optionfont -family sans-serif -size -12
5338 switch -regexp -- $arg {
5340 "^-d" { set datemode 1 }
5342 lappend revtreeargs $arg
5347 # check that we can find a .git directory somewhere...
5349 if {![file isdirectory $gitdir]} {
5350 show_error . "Cannot find the git directory \"$gitdir\"."
5354 set cmdline_files {}
5355 set i [lsearch -exact $revtreeargs "--"]
5357 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5358 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5359 } elseif {$revtreeargs ne {}} {
5361 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5362 set cmdline_files [split $f "\n"]
5363 set n [llength $cmdline_files]
5364 set revtreeargs [lrange $revtreeargs 0 end-$n]
5366 # unfortunately we get both stdout and stderr in $err,
5367 # so look for "fatal:".
5368 set i [string first "fatal:" $err]
5370 set err [string range [expr {$i + 6}] end]
5372 show_error . "Bad arguments to gitk:\n$err"
5381 set highlight_paths {}
5382 set searchdirn -forwards
5391 set selectedhlview None
5404 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5405 # create a view for the files/dirs specified on the command line
5409 set viewname(1) "Command line"
5410 set viewfiles(1) $cmdline_files
5411 set viewargs(1) $revtreeargs
5414 .bar.view entryconf 2 -state normal
5415 .bar.view entryconf 3 -state normal
5418 if {[info exists permviews]} {
5419 foreach v $permviews {
5422 set viewname($n) [lindex $v 0]
5423 set viewfiles($n) [lindex $v 1]
5424 set viewargs($n) [lindex $v 2]