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 bindkey <Key-Right> "goforw"
636 bindkey <Key-Left> "goback"
637 bind . <Key-Prior> "selnextpage -1"
638 bind . <Key-Next> "selnextpage 1"
639 bind . <Control-Home> "allcanvs yview moveto 0.0"
640 bind . <Control-End> "allcanvs yview moveto 1.0"
641 bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
642 bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
643 bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
644 bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
645 bindkey <Key-Delete> "$ctext yview scroll -1 pages"
646 bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
647 bindkey <Key-space> "$ctext yview scroll 1 pages"
648 bindkey p "selnextline -1"
649 bindkey n "selnextline 1"
652 bindkey i "selnextline -1"
653 bindkey k "selnextline 1"
656 bindkey b "$ctext yview scroll -1 pages"
657 bindkey d "$ctext yview scroll 18 units"
658 bindkey u "$ctext yview scroll -18 units"
659 bindkey / {findnext 1}
660 bindkey <Key-Return> {findnext 0}
663 bind . <Control-q> doquit
664 bind . <Control-f> dofind
665 bind . <Control-g> {findnext 0}
666 bind . <Control-r> dosearchback
667 bind . <Control-s> dosearch
668 bind . <Control-equal> {incrfont 1}
669 bind . <Control-KP_Add> {incrfont 1}
670 bind . <Control-minus> {incrfont -1}
671 bind . <Control-KP_Subtract> {incrfont -1}
672 bind . <Destroy> {savestuff %W}
673 bind . <Button-1> "click %W"
674 bind $fstring <Key-Return> dofind
675 bind $sha1entry <Key-Return> gotocommit
676 bind $sha1entry <<PasteSelection>> clearsha1
677 bind $cflist <1> {sel_flist %W %x %y; break}
678 bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
679 bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
681 set maincursor [. cget -cursor]
682 set textcursor [$ctext cget -cursor]
683 set curtextcursor $textcursor
685 set rowctxmenu .rowctxmenu
686 menu $rowctxmenu -tearoff 0
687 $rowctxmenu add command -label "Diff this -> selected" \
688 -command {diffvssel 0}
689 $rowctxmenu add command -label "Diff selected -> this" \
690 -command {diffvssel 1}
691 $rowctxmenu add command -label "Make patch" -command mkpatch
692 $rowctxmenu add command -label "Create tag" -command mktag
693 $rowctxmenu add command -label "Write commit to file" -command writecommit
696 # mouse-2 makes all windows scan vertically, but only the one
697 # the cursor is in scans horizontally
698 proc canvscan {op w x y} {
699 global canv canv2 canv3
700 foreach c [list $canv $canv2 $canv3] {
709 proc scrollcanv {cscroll f0 f1} {
715 # when we make a key binding for the toplevel, make sure
716 # it doesn't get triggered when that key is pressed in the
717 # find string entry widget.
718 proc bindkey {ev script} {
721 set escript [bind Entry $ev]
722 if {$escript == {}} {
723 set escript [bind Entry <Key>]
726 bind $e $ev "$escript; break"
730 # set the focus back to the toplevel for any click outside
741 global canv canv2 canv3 ctext cflist mainfont textfont uifont
742 global stuffsaved findmergefiles maxgraphpct
744 global viewname viewfiles viewargs viewperm nextviewnum
747 if {$stuffsaved} return
748 if {![winfo viewable .]} return
750 set f [open "~/.gitk-new" w]
751 puts $f [list set mainfont $mainfont]
752 puts $f [list set textfont $textfont]
753 puts $f [list set uifont $uifont]
754 puts $f [list set findmergefiles $findmergefiles]
755 puts $f [list set maxgraphpct $maxgraphpct]
756 puts $f [list set maxwidth $maxwidth]
757 puts $f [list set cmitmode $cmitmode]
758 puts $f "set geometry(width) [winfo width .ctop]"
759 puts $f "set geometry(height) [winfo height .ctop]"
760 puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
761 puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
762 puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
763 puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
764 set wid [expr {([winfo width $ctext] - 8) \
765 / [font measure $textfont "0"]}]
766 puts $f "set geometry(ctextw) $wid"
767 set wid [expr {([winfo width $cflist] - 11) \
768 / [font measure [$cflist cget -font] "0"]}]
769 puts $f "set geometry(cflistw) $wid"
770 puts -nonewline $f "set permviews {"
771 for {set v 0} {$v < $nextviewnum} {incr v} {
773 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
778 file rename -force "~/.gitk-new" "~/.gitk"
783 proc resizeclistpanes {win w} {
785 if {[info exists oldwidth($win)]} {
786 set s0 [$win sash coord 0]
787 set s1 [$win sash coord 1]
789 set sash0 [expr {int($w/2 - 2)}]
790 set sash1 [expr {int($w*5/6 - 2)}]
792 set factor [expr {1.0 * $w / $oldwidth($win)}]
793 set sash0 [expr {int($factor * [lindex $s0 0])}]
794 set sash1 [expr {int($factor * [lindex $s1 0])}]
798 if {$sash1 < $sash0 + 20} {
799 set sash1 [expr {$sash0 + 20}]
801 if {$sash1 > $w - 10} {
802 set sash1 [expr {$w - 10}]
803 if {$sash0 > $sash1 - 20} {
804 set sash0 [expr {$sash1 - 20}]
808 $win sash place 0 $sash0 [lindex $s0 1]
809 $win sash place 1 $sash1 [lindex $s1 1]
811 set oldwidth($win) $w
814 proc resizecdetpanes {win w} {
816 if {[info exists oldwidth($win)]} {
817 set s0 [$win sash coord 0]
819 set sash0 [expr {int($w*3/4 - 2)}]
821 set factor [expr {1.0 * $w / $oldwidth($win)}]
822 set sash0 [expr {int($factor * [lindex $s0 0])}]
826 if {$sash0 > $w - 15} {
827 set sash0 [expr {$w - 15}]
830 $win sash place 0 $sash0 [lindex $s0 1]
832 set oldwidth($win) $w
836 global canv canv2 canv3
842 proc bindall {event action} {
843 global canv canv2 canv3
844 bind $canv $event $action
845 bind $canv2 $event $action
846 bind $canv3 $event $action
851 if {[winfo exists $w]} {
856 wm title $w "About gitk"
858 Gitk - a commit viewer for git
860 Copyright © 2005-2006 Paul Mackerras
862 Use and redistribute under the terms of the GNU General Public License} \
863 -justify center -aspect 400
864 pack $w.m -side top -fill x -padx 20 -pady 20
865 button $w.ok -text Close -command "destroy $w"
866 pack $w.ok -side bottom
871 if {[winfo exists $w]} {
876 wm title $w "Gitk key bindings"
881 <Home> Move to first commit
882 <End> Move to last commit
883 <Up>, p, i Move up one commit
884 <Down>, n, k Move down one commit
885 <Left>, z, j Go back in history list
886 <Right>, x, l Go forward in history list
887 <PageUp> Move up one page in commit list
888 <PageDown> Move down one page in commit list
889 <Ctrl-Home> Scroll to top of commit list
890 <Ctrl-End> Scroll to bottom of commit list
891 <Ctrl-Up> Scroll commit list up one line
892 <Ctrl-Down> Scroll commit list down one line
893 <Ctrl-PageUp> Scroll commit list up one page
894 <Ctrl-PageDown> Scroll commit list down one page
895 <Delete>, b Scroll diff view up one page
896 <Backspace> Scroll diff view up one page
897 <Space> Scroll diff view down one page
898 u Scroll diff view up 18 lines
899 d Scroll diff view down 18 lines
901 <Ctrl-G> Move to next find hit
902 <Ctrl-R> Move to previous find hit
903 <Return> Move to next find hit
904 / Move to next find hit, or redo find
905 ? Move to previous find hit
906 f Scroll diff view to next file
907 <Ctrl-KP+> Increase font size
908 <Ctrl-plus> Increase font size
909 <Ctrl-KP-> Decrease font size
910 <Ctrl-minus> Decrease font size
912 -justify left -bg white -border 2 -relief sunken
913 pack $w.m -side top -fill both
914 button $w.ok -text Close -command "destroy $w"
915 pack $w.ok -side bottom
918 # Procedures for manipulating the file list window at the
919 # bottom right of the overall window.
921 proc treeview {w l openlevs} {
922 global treecontents treediropen treeheight treeparent treeindex
932 set treecontents() {}
933 $w conf -state normal
935 while {[string range $f 0 $prefixend] ne $prefix} {
936 if {$lev <= $openlevs} {
937 $w mark set e:$treeindex($prefix) "end -1c"
938 $w mark gravity e:$treeindex($prefix) left
940 set treeheight($prefix) $ht
941 incr ht [lindex $htstack end]
942 set htstack [lreplace $htstack end end]
943 set prefixend [lindex $prefendstack end]
944 set prefendstack [lreplace $prefendstack end end]
945 set prefix [string range $prefix 0 $prefixend]
948 set tail [string range $f [expr {$prefixend+1}] end]
949 while {[set slash [string first "/" $tail]] >= 0} {
952 lappend prefendstack $prefixend
953 incr prefixend [expr {$slash + 1}]
954 set d [string range $tail 0 $slash]
955 lappend treecontents($prefix) $d
956 set oldprefix $prefix
958 set treecontents($prefix) {}
959 set treeindex($prefix) [incr ix]
960 set treeparent($prefix) $oldprefix
961 set tail [string range $tail [expr {$slash+1}] end]
962 if {$lev <= $openlevs} {
964 set treediropen($prefix) [expr {$lev < $openlevs}]
965 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
966 $w mark set d:$ix "end -1c"
967 $w mark gravity d:$ix left
969 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
971 $w image create end -align center -image $bm -padx 1 \
973 $w insert end $d [highlight_tag $prefix]
974 $w mark set s:$ix "end -1c"
975 $w mark gravity s:$ix left
980 if {$lev <= $openlevs} {
983 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
985 $w insert end $tail [highlight_tag $f]
987 lappend treecontents($prefix) $tail
990 while {$htstack ne {}} {
991 set treeheight($prefix) $ht
992 incr ht [lindex $htstack end]
993 set htstack [lreplace $htstack end end]
995 $w conf -state disabled
999 global treeheight treecontents
1004 foreach e $treecontents($prefix) {
1009 if {[string index $e end] eq "/"} {
1010 set n $treeheight($prefix$e)
1022 proc highlight_tree {y prefix} {
1023 global treeheight treecontents cflist
1025 foreach e $treecontents($prefix) {
1027 if {[highlight_tag $path] ne {}} {
1028 $cflist tag add bold $y.0 "$y.0 lineend"
1031 if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1032 set y [highlight_tree $y $path]
1038 proc treeclosedir {w dir} {
1039 global treediropen treeheight treeparent treeindex
1041 set ix $treeindex($dir)
1042 $w conf -state normal
1043 $w delete s:$ix e:$ix
1044 set treediropen($dir) 0
1045 $w image configure a:$ix -image tri-rt
1046 $w conf -state disabled
1047 set n [expr {1 - $treeheight($dir)}]
1048 while {$dir ne {}} {
1049 incr treeheight($dir) $n
1050 set dir $treeparent($dir)
1054 proc treeopendir {w dir} {
1055 global treediropen treeheight treeparent treecontents treeindex
1057 set ix $treeindex($dir)
1058 $w conf -state normal
1059 $w image configure a:$ix -image tri-dn
1060 $w mark set e:$ix s:$ix
1061 $w mark gravity e:$ix right
1064 set n [llength $treecontents($dir)]
1065 for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1068 incr treeheight($x) $n
1070 foreach e $treecontents($dir) {
1072 if {[string index $e end] eq "/"} {
1073 set iy $treeindex($de)
1074 $w mark set d:$iy e:$ix
1075 $w mark gravity d:$iy left
1076 $w insert e:$ix $str
1077 set treediropen($de) 0
1078 $w image create e:$ix -align center -image tri-rt -padx 1 \
1080 $w insert e:$ix $e [highlight_tag $de]
1081 $w mark set s:$iy e:$ix
1082 $w mark gravity s:$iy left
1083 set treeheight($de) 1
1085 $w insert e:$ix $str
1086 $w insert e:$ix $e [highlight_tag $de]
1089 $w mark gravity e:$ix left
1090 $w conf -state disabled
1091 set treediropen($dir) 1
1092 set top [lindex [split [$w index @0,0] .] 0]
1093 set ht [$w cget -height]
1094 set l [lindex [split [$w index s:$ix] .] 0]
1097 } elseif {$l + $n + 1 > $top + $ht} {
1098 set top [expr {$l + $n + 2 - $ht}]
1106 proc treeclick {w x y} {
1107 global treediropen cmitmode ctext cflist cflist_top
1109 if {$cmitmode ne "tree"} return
1110 if {![info exists cflist_top]} return
1111 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1112 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1113 $cflist tag add highlight $l.0 "$l.0 lineend"
1119 set e [linetoelt $l]
1120 if {[string index $e end] ne "/"} {
1122 } elseif {$treediropen($e)} {
1129 proc setfilelist {id} {
1130 global treefilelist cflist
1132 treeview $cflist $treefilelist($id) 0
1135 image create bitmap tri-rt -background black -foreground blue -data {
1136 #define tri-rt_width 13
1137 #define tri-rt_height 13
1138 static unsigned char tri-rt_bits[] = {
1139 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1140 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1143 #define tri-rt-mask_width 13
1144 #define tri-rt-mask_height 13
1145 static unsigned char tri-rt-mask_bits[] = {
1146 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1147 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1150 image create bitmap tri-dn -background black -foreground blue -data {
1151 #define tri-dn_width 13
1152 #define tri-dn_height 13
1153 static unsigned char tri-dn_bits[] = {
1154 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1155 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1158 #define tri-dn-mask_width 13
1159 #define tri-dn-mask_height 13
1160 static unsigned char tri-dn-mask_bits[] = {
1161 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1162 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1166 proc init_flist {first} {
1167 global cflist cflist_top selectedline difffilestart
1169 $cflist conf -state normal
1170 $cflist delete 0.0 end
1172 $cflist insert end $first
1174 $cflist tag add highlight 1.0 "1.0 lineend"
1176 catch {unset cflist_top}
1178 $cflist conf -state disabled
1179 set difffilestart {}
1182 proc highlight_tag {f} {
1183 global highlight_paths
1185 foreach p $highlight_paths {
1186 if {[string match $p $f]} {
1193 proc highlight_filelist {} {
1194 global cmitmode cflist
1196 $cflist conf -state normal
1197 if {$cmitmode ne "tree"} {
1198 set end [lindex [split [$cflist index end] .] 0]
1199 for {set l 2} {$l < $end} {incr l} {
1200 set line [$cflist get $l.0 "$l.0 lineend"]
1201 if {[highlight_tag $line] ne {}} {
1202 $cflist tag add bold $l.0 "$l.0 lineend"
1208 $cflist conf -state disabled
1211 proc unhighlight_filelist {} {
1214 $cflist conf -state normal
1215 $cflist tag remove bold 1.0 end
1216 $cflist conf -state disabled
1219 proc add_flist {fl} {
1222 $cflist conf -state normal
1224 $cflist insert end "\n"
1225 $cflist insert end $f [highlight_tag $f]
1227 $cflist conf -state disabled
1230 proc sel_flist {w x y} {
1231 global ctext difffilestart cflist cflist_top cmitmode
1233 if {$cmitmode eq "tree"} return
1234 if {![info exists cflist_top]} return
1235 set l [lindex [split [$w index "@$x,$y"] "."] 0]
1236 $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1237 $cflist tag add highlight $l.0 "$l.0 lineend"
1242 catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1246 # Functions for adding and removing shell-type quoting
1248 proc shellquote {str} {
1249 if {![string match "*\['\"\\ \t]*" $str]} {
1252 if {![string match "*\['\"\\]*" $str]} {
1255 if {![string match "*'*" $str]} {
1258 return "\"[string map {\" \\\" \\ \\\\} $str]\""
1261 proc shellarglist {l} {
1267 append str [shellquote $a]
1272 proc shelldequote {str} {
1277 if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1278 append ret [string range $str $used end]
1279 set used [string length $str]
1282 set first [lindex $first 0]
1283 set ch [string index $str $first]
1284 if {$first > $used} {
1285 append ret [string range $str $used [expr {$first - 1}]]
1288 if {$ch eq " " || $ch eq "\t"} break
1291 set first [string first "'" $str $used]
1293 error "unmatched single-quote"
1295 append ret [string range $str $used [expr {$first - 1}]]
1300 if {$used >= [string length $str]} {
1301 error "trailing backslash"
1303 append ret [string index $str $used]
1308 if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1309 error "unmatched double-quote"
1311 set first [lindex $first 0]
1312 set ch [string index $str $first]
1313 if {$first > $used} {
1314 append ret [string range $str $used [expr {$first - 1}]]
1317 if {$ch eq "\""} break
1319 append ret [string index $str $used]
1323 return [list $used $ret]
1326 proc shellsplit {str} {
1329 set str [string trimleft $str]
1330 if {$str eq {}} break
1331 set dq [shelldequote $str]
1332 set n [lindex $dq 0]
1333 set word [lindex $dq 1]
1334 set str [string range $str $n end]
1340 # Code to implement multiple views
1342 proc newview {ishighlight} {
1343 global nextviewnum newviewname newviewperm uifont newishighlight
1344 global newviewargs revtreeargs
1346 set newishighlight $ishighlight
1348 if {[winfo exists $top]} {
1352 set newviewname($nextviewnum) "View $nextviewnum"
1353 set newviewperm($nextviewnum) 0
1354 set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1355 vieweditor $top $nextviewnum "Gitk view definition"
1360 global viewname viewperm newviewname newviewperm
1361 global viewargs newviewargs
1363 set top .gitkvedit-$curview
1364 if {[winfo exists $top]} {
1368 set newviewname($curview) $viewname($curview)
1369 set newviewperm($curview) $viewperm($curview)
1370 set newviewargs($curview) [shellarglist $viewargs($curview)]
1371 vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1374 proc vieweditor {top n title} {
1375 global newviewname newviewperm viewfiles
1379 wm title $top $title
1380 label $top.nl -text "Name" -font $uifont
1381 entry $top.name -width 20 -textvariable newviewname($n)
1382 grid $top.nl $top.name -sticky w -pady 5
1383 checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1384 grid $top.perm - -pady 5 -sticky w
1385 message $top.al -aspect 1000 -font $uifont \
1386 -text "Commits to include (arguments to git-rev-list):"
1387 grid $top.al - -sticky w -pady 5
1388 entry $top.args -width 50 -textvariable newviewargs($n) \
1390 grid $top.args - -sticky ew -padx 5
1391 message $top.l -aspect 1000 -font $uifont \
1392 -text "Enter files and directories to include, one per line:"
1393 grid $top.l - -sticky w
1394 text $top.t -width 40 -height 10 -background white
1395 if {[info exists viewfiles($n)]} {
1396 foreach f $viewfiles($n) {
1397 $top.t insert end $f
1398 $top.t insert end "\n"
1400 $top.t delete {end - 1c} end
1401 $top.t mark set insert 0.0
1403 grid $top.t - -sticky ew -padx 5
1405 button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1406 button $top.buts.can -text "Cancel" -command [list destroy $top]
1407 grid $top.buts.ok $top.buts.can
1408 grid columnconfigure $top.buts 0 -weight 1 -uniform a
1409 grid columnconfigure $top.buts 1 -weight 1 -uniform a
1410 grid $top.buts - -pady 10 -sticky ew
1414 proc doviewmenu {m first cmd op argv} {
1415 set nmenu [$m index end]
1416 for {set i $first} {$i <= $nmenu} {incr i} {
1417 if {[$m entrycget $i -command] eq $cmd} {
1418 eval $m $op $i $argv
1424 proc allviewmenus {n op args} {
1427 doviewmenu .bar.view 7 [list showview $n] $op $args
1428 doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1431 proc newviewok {top n} {
1432 global nextviewnum newviewperm newviewname newishighlight
1433 global viewname viewfiles viewperm selectedview curview
1434 global viewargs newviewargs viewhlmenu
1437 set newargs [shellsplit $newviewargs($n)]
1439 error_popup "Error in commit selection arguments: $err"
1445 foreach f [split [$top.t get 0.0 end] "\n"] {
1446 set ft [string trim $f]
1451 if {![info exists viewfiles($n)]} {
1452 # creating a new view
1454 set viewname($n) $newviewname($n)
1455 set viewperm($n) $newviewperm($n)
1456 set viewfiles($n) $files
1457 set viewargs($n) $newargs
1459 if {!$newishighlight} {
1460 after idle showview $n
1462 after idle addvhighlight $n
1465 # editing an existing view
1466 set viewperm($n) $newviewperm($n)
1467 if {$newviewname($n) ne $viewname($n)} {
1468 set viewname($n) $newviewname($n)
1469 doviewmenu .bar.view 7 [list showview $n] \
1470 entryconf [list -label $viewname($n)]
1471 doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1472 entryconf [list -label $viewname($n) -value $viewname($n)]
1474 if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1475 set viewfiles($n) $files
1476 set viewargs($n) $newargs
1477 if {$curview == $n} {
1478 after idle updatecommits
1482 catch {destroy $top}
1486 global curview viewdata viewperm hlview selectedhlview
1488 if {$curview == 0} return
1489 if {[info exists hlview] && $hlview == $curview} {
1490 set selectedhlview None
1493 allviewmenus $curview delete
1494 set viewdata($curview) {}
1495 set viewperm($curview) 0
1499 proc addviewmenu {n} {
1500 global viewname viewhlmenu
1502 .bar.view add radiobutton -label $viewname($n) \
1503 -command [list showview $n] -variable selectedview -value $n
1504 $viewhlmenu add radiobutton -label $viewname($n) \
1505 -command [list addvhighlight $n] -variable selectedhlview
1508 proc flatten {var} {
1512 foreach i [array names $var] {
1513 lappend ret $i [set $var\($i\)]
1518 proc unflatten {var l} {
1528 global curview viewdata viewfiles
1529 global displayorder parentlist childlist rowidlist rowoffsets
1530 global colormap rowtextx commitrow nextcolor canvxmax
1531 global numcommits rowrangelist commitlisted idrowranges
1532 global selectedline currentid canv canvy0
1533 global matchinglines treediffs
1534 global pending_select phase
1535 global commitidx rowlaidout rowoptim linesegends
1536 global commfd nextupdate
1538 global vparentlist vchildlist vdisporder vcmitlisted
1539 global hlview selectedhlview
1541 if {$n == $curview} return
1543 if {[info exists selectedline]} {
1544 set selid $currentid
1545 set y [yc $selectedline]
1546 set ymax [lindex [$canv cget -scrollregion] 3]
1547 set span [$canv yview]
1548 set ytop [expr {[lindex $span 0] * $ymax}]
1549 set ybot [expr {[lindex $span 1] * $ymax}]
1550 if {$ytop < $y && $y < $ybot} {
1551 set yscreen [expr {$y - $ytop}]
1553 set yscreen [expr {($ybot - $ytop) / 2}]
1559 if {$curview >= 0} {
1560 set vparentlist($curview) $parentlist
1561 set vchildlist($curview) $childlist
1562 set vdisporder($curview) $displayorder
1563 set vcmitlisted($curview) $commitlisted
1565 set viewdata($curview) \
1566 [list $phase $rowidlist $rowoffsets $rowrangelist \
1567 [flatten idrowranges] [flatten idinlist] \
1568 $rowlaidout $rowoptim $numcommits $linesegends]
1569 } elseif {![info exists viewdata($curview)]
1570 || [lindex $viewdata($curview) 0] ne {}} {
1571 set viewdata($curview) \
1572 [list {} $rowidlist $rowoffsets $rowrangelist]
1575 catch {unset matchinglines}
1576 catch {unset treediffs}
1578 if {[info exists hlview] && $hlview == $n} {
1580 set selectedhlview None
1585 .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1586 .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1588 if {![info exists viewdata($n)]} {
1589 set pending_select $selid
1595 set phase [lindex $v 0]
1596 set displayorder $vdisporder($n)
1597 set parentlist $vparentlist($n)
1598 set childlist $vchildlist($n)
1599 set commitlisted $vcmitlisted($n)
1600 set rowidlist [lindex $v 1]
1601 set rowoffsets [lindex $v 2]
1602 set rowrangelist [lindex $v 3]
1604 set numcommits [llength $displayorder]
1605 catch {unset idrowranges}
1607 unflatten idrowranges [lindex $v 4]
1608 unflatten idinlist [lindex $v 5]
1609 set rowlaidout [lindex $v 6]
1610 set rowoptim [lindex $v 7]
1611 set numcommits [lindex $v 8]
1612 set linesegends [lindex $v 9]
1615 catch {unset colormap}
1616 catch {unset rowtextx}
1618 set canvxmax [$canv cget -width]
1624 if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1625 set row $commitrow($n,$selid)
1626 # try to get the selected row in the same position on the screen
1627 set ymax [lindex [$canv cget -scrollregion] 3]
1628 set ytop [expr {[yc $row] - $yscreen}]
1632 set yf [expr {$ytop * 1.0 / $ymax}]
1634 allcanvs yview moveto $yf
1638 if {$phase eq "getcommits"} {
1639 show_status "Reading commits..."
1641 if {[info exists commfd($n)]} {
1646 } elseif {$numcommits == 0} {
1647 show_status "No commits selected"
1651 # Stuff relating to the highlighting facility
1653 proc ishighlighted {row} {
1654 global vhighlights fhighlights nhighlights rhighlights
1656 if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1657 return $nhighlights($row)
1659 if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1660 return $vhighlights($row)
1662 if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1663 return $fhighlights($row)
1665 if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1666 return $rhighlights($row)
1671 proc bolden {row font} {
1672 global canv linehtag selectedline
1674 $canv itemconf $linehtag($row) -font $font
1675 if {[info exists selectedline] && $row == $selectedline} {
1677 set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1678 -outline {{}} -tags secsel \
1679 -fill [$canv cget -selectbackground]]
1684 proc bolden_name {row font} {
1685 global canv2 linentag selectedline
1687 $canv2 itemconf $linentag($row) -font $font
1688 if {[info exists selectedline] && $row == $selectedline} {
1689 $canv2 delete secsel
1690 set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1691 -outline {{}} -tags secsel \
1692 -fill [$canv2 cget -selectbackground]]
1697 proc unbolden {rows} {
1701 if {![ishighlighted $row]} {
1702 bolden $row $mainfont
1707 proc addvhighlight {n} {
1708 global hlview curview viewdata vhl_done vhighlights commitidx
1710 if {[info exists hlview]} {
1714 if {$n != $curview && ![info exists viewdata($n)]} {
1715 set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1716 set vparentlist($n) {}
1717 set vchildlist($n) {}
1718 set vdisporder($n) {}
1719 set vcmitlisted($n) {}
1722 set vhl_done $commitidx($hlview)
1723 if {$vhl_done > 0} {
1728 proc delvhighlight {} {
1729 global hlview vhighlights
1731 if {![info exists hlview]} return
1733 set rows [array names vhighlights]
1740 proc vhighlightmore {} {
1741 global hlview vhl_done commitidx vhighlights
1742 global displayorder vdisporder curview mainfont
1744 set font [concat $mainfont bold]
1745 set max $commitidx($hlview)
1746 if {$hlview == $curview} {
1747 set disp $displayorder
1749 set disp $vdisporder($hlview)
1751 set vr [visiblerows]
1752 set r0 [lindex $vr 0]
1753 set r1 [lindex $vr 1]
1754 for {set i $vhl_done} {$i < $max} {incr i} {
1755 set id [lindex $disp $i]
1756 if {[info exists commitrow($curview,$id)]} {
1757 set row $commitrow($curview,$id)
1758 if {$r0 <= $row && $row <= $r1} {
1759 if {![highlighted $row]} {
1762 set vhighlights($row) 1
1769 proc askvhighlight {row id} {
1770 global hlview vhighlights commitrow iddrawn mainfont
1772 if {[info exists commitrow($hlview,$id)]} {
1773 if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1774 bolden $row [concat $mainfont bold]
1776 set vhighlights($row) 1
1778 set vhighlights($row) 0
1782 proc hfiles_change {name ix op} {
1783 global highlight_files filehighlight fhighlights fh_serial
1784 global mainfont highlight_paths
1786 if {[info exists filehighlight]} {
1787 # delete previous highlights
1788 catch {close $filehighlight}
1790 set rows [array names fhighlights]
1795 unhighlight_filelist
1797 set highlight_paths {}
1798 after cancel do_file_hl $fh_serial
1800 if {$highlight_files ne {}} {
1801 after 300 do_file_hl $fh_serial
1805 proc makepatterns {l} {
1808 set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1809 if {[string index $ee end] eq "/"} {
1819 proc do_file_hl {serial} {
1820 global highlight_files filehighlight highlight_paths gdttype
1822 if {$gdttype eq "touching paths:"} {
1823 if {[catch {set paths [shellsplit $highlight_files]}]} return
1824 set highlight_paths [makepatterns $paths]
1826 set gdtargs [concat -- $paths]
1828 set gdtargs [list "-S$highlight_files"]
1830 set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1831 set filehighlight [open $cmd r+]
1832 fconfigure $filehighlight -blocking 0
1833 fileevent $filehighlight readable readfhighlight
1838 proc flushhighlights {} {
1839 global filehighlight
1841 if {[info exists filehighlight]} {
1842 puts $filehighlight ""
1843 flush $filehighlight
1847 proc askfilehighlight {row id} {
1848 global filehighlight fhighlights
1850 set fhighlights($row) 0
1851 puts $filehighlight $id
1854 proc readfhighlight {} {
1855 global filehighlight fhighlights commitrow curview mainfont iddrawn
1857 set n [gets $filehighlight line]
1859 if {[eof $filehighlight]} {
1861 puts "oops, git-diff-tree died"
1862 catch {close $filehighlight}
1867 set line [string trim $line]
1868 if {$line eq {}} return
1869 if {![info exists commitrow($curview,$line)]} return
1870 set row $commitrow($curview,$line)
1871 if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1872 bolden $row [concat $mainfont bold]
1874 set fhighlights($row) 1
1877 proc find_change {name ix op} {
1878 global nhighlights mainfont
1879 global findstring findpattern findtype
1881 # delete previous highlights, if any
1882 set rows [array names nhighlights]
1885 if {$nhighlights($row) >= 2} {
1886 bolden_name $row $mainfont
1892 if {$findtype ne "Regexp"} {
1893 set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1895 set findpattern "*$e*"
1900 proc askfindhighlight {row id} {
1901 global nhighlights commitinfo iddrawn mainfont
1902 global findstring findtype findloc findpattern
1904 if {![info exists commitinfo($id)]} {
1907 set info $commitinfo($id)
1909 set fldtypes {Headline Author Date Committer CDate Comments}
1910 foreach f $info ty $fldtypes {
1911 if {$findloc ne "All fields" && $findloc ne $ty} {
1914 if {$findtype eq "Regexp"} {
1915 set doesmatch [regexp $findstring $f]
1916 } elseif {$findtype eq "IgnCase"} {
1917 set doesmatch [string match -nocase $findpattern $f]
1919 set doesmatch [string match $findpattern $f]
1922 if {$ty eq "Author"} {
1929 if {[info exists iddrawn($id)]} {
1930 if {$isbold && ![ishighlighted $row]} {
1931 bolden $row [concat $mainfont bold]
1934 bolden_name $row [concat $mainfont bold]
1937 set nhighlights($row) $isbold
1940 proc vrel_change {name ix op} {
1941 global highlight_related
1944 if {$highlight_related ne "None"} {
1945 after idle drawvisible
1949 # prepare for testing whether commits are descendents or ancestors of a
1950 proc rhighlight_sel {a} {
1951 global descendent desc_todo ancestor anc_todo
1952 global highlight_related rhighlights
1954 catch {unset descendent}
1955 set desc_todo [list $a]
1956 catch {unset ancestor}
1957 set anc_todo [list $a]
1958 if {$highlight_related ne "None"} {
1960 after idle drawvisible
1964 proc rhighlight_none {} {
1967 set rows [array names rhighlights]
1974 proc is_descendent {a} {
1975 global curview children commitrow descendent desc_todo
1978 set la $commitrow($v,$a)
1982 for {set i 0} {$i < [llength $todo]} {incr i} {
1983 set do [lindex $todo $i]
1984 if {$commitrow($v,$do) < $la} {
1985 lappend leftover $do
1988 foreach nk $children($v,$do) {
1989 if {![info exists descendent($nk)]} {
1990 set descendent($nk) 1
1998 set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2002 set descendent($a) 0
2003 set desc_todo $leftover
2006 proc is_ancestor {a} {
2007 global curview parentlist commitrow ancestor anc_todo
2010 set la $commitrow($v,$a)
2014 for {set i 0} {$i < [llength $todo]} {incr i} {
2015 set do [lindex $todo $i]
2016 if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2017 lappend leftover $do
2020 foreach np [lindex $parentlist $commitrow($v,$do)] {
2021 if {![info exists ancestor($np)]} {
2030 set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2035 set anc_todo $leftover
2038 proc askrelhighlight {row id} {
2039 global descendent highlight_related iddrawn mainfont rhighlights
2040 global selectedline ancestor
2042 if {![info exists selectedline]} return
2044 if {$highlight_related eq "Descendent" ||
2045 $highlight_related eq "Not descendent"} {
2046 if {![info exists descendent($id)]} {
2049 if {$descendent($id) == ($highlight_related eq "Descendent")} {
2052 } elseif {$highlight_related eq "Ancestor" ||
2053 $highlight_related eq "Not ancestor"} {
2054 if {![info exists ancestor($id)]} {
2057 if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2061 if {[info exists iddrawn($id)]} {
2062 if {$isbold && ![ishighlighted $row]} {
2063 bolden $row [concat $mainfont bold]
2066 set rhighlights($row) $isbold
2069 # Graph layout functions
2071 proc shortids {ids} {
2074 if {[llength $id] > 1} {
2075 lappend res [shortids $id]
2076 } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2077 lappend res [string range $id 0 7]
2085 proc incrange {l x o} {
2088 set e [lindex $l $x]
2090 lset l $x [expr {$e + $o}]
2099 for {} {$n > 0} {incr n -1} {
2105 proc usedinrange {id l1 l2} {
2106 global children commitrow childlist curview
2108 if {[info exists commitrow($curview,$id)]} {
2109 set r $commitrow($curview,$id)
2110 if {$l1 <= $r && $r <= $l2} {
2111 return [expr {$r - $l1 + 1}]
2113 set kids [lindex $childlist $r]
2115 set kids $children($curview,$id)
2118 set r $commitrow($curview,$c)
2119 if {$l1 <= $r && $r <= $l2} {
2120 return [expr {$r - $l1 + 1}]
2126 proc sanity {row {full 0}} {
2127 global rowidlist rowoffsets
2130 set ids [lindex $rowidlist $row]
2133 if {$id eq {}} continue
2134 if {$col < [llength $ids] - 1 &&
2135 [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2136 puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2138 set o [lindex $rowoffsets $row $col]
2144 if {[lindex $rowidlist $y $x] != $id} {
2145 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2146 puts " id=[shortids $id] check started at row $row"
2147 for {set i $row} {$i >= $y} {incr i -1} {
2148 puts " row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2153 set o [lindex $rowoffsets $y $x]
2158 proc makeuparrow {oid x y z} {
2159 global rowidlist rowoffsets uparrowlen idrowranges
2161 for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2164 set off0 [lindex $rowoffsets $y]
2165 for {set x0 $x} {1} {incr x0} {
2166 if {$x0 >= [llength $off0]} {
2167 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2170 set z [lindex $off0 $x0]
2176 set z [expr {$x0 - $x}]
2177 lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2178 lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2180 set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2181 lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2182 lappend idrowranges($oid) $y
2185 proc initlayout {} {
2186 global rowidlist rowoffsets displayorder commitlisted
2187 global rowlaidout rowoptim
2188 global idinlist rowchk rowrangelist idrowranges
2189 global numcommits canvxmax canv
2191 global parentlist childlist children
2192 global colormap rowtextx
2204 catch {unset idinlist}
2205 catch {unset rowchk}
2208 set canvxmax [$canv cget -width]
2209 catch {unset colormap}
2210 catch {unset rowtextx}
2211 catch {unset idrowranges}
2215 proc setcanvscroll {} {
2216 global canv canv2 canv3 numcommits linespc canvxmax canvy0
2218 set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2219 $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2220 $canv2 conf -scrollregion [list 0 0 0 $ymax]
2221 $canv3 conf -scrollregion [list 0 0 0 $ymax]
2224 proc visiblerows {} {
2225 global canv numcommits linespc
2227 set ymax [lindex [$canv cget -scrollregion] 3]
2228 if {$ymax eq {} || $ymax == 0} return
2230 set y0 [expr {int([lindex $f 0] * $ymax)}]
2231 set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2235 set y1 [expr {int([lindex $f 1] * $ymax)}]
2236 set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2237 if {$r1 >= $numcommits} {
2238 set r1 [expr {$numcommits - 1}]
2240 return [list $r0 $r1]
2243 proc layoutmore {} {
2244 global rowlaidout rowoptim commitidx numcommits optim_delay
2245 global uparrowlen curview
2248 set rowlaidout [layoutrows $row $commitidx($curview) 0]
2249 set orow [expr {$rowlaidout - $uparrowlen - 1}]
2250 if {$orow > $rowoptim} {
2251 optimize_rows $rowoptim 0 $orow
2254 set canshow [expr {$rowoptim - $optim_delay}]
2255 if {$canshow > $numcommits} {
2260 proc showstuff {canshow} {
2261 global numcommits commitrow pending_select selectedline
2262 global linesegends idrowranges idrangedrawn curview
2264 if {$numcommits == 0} {
2266 set phase "incrdraw"
2270 set numcommits $canshow
2272 set rows [visiblerows]
2273 set r0 [lindex $rows 0]
2274 set r1 [lindex $rows 1]
2276 for {set r $row} {$r < $canshow} {incr r} {
2277 foreach id [lindex $linesegends [expr {$r+1}]] {
2279 foreach {s e} [rowranges $id] {
2281 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2282 && ![info exists idrangedrawn($id,$i)]} {
2284 set idrangedrawn($id,$i) 1
2289 if {$canshow > $r1} {
2292 while {$row < $canshow} {
2296 if {[info exists pending_select] &&
2297 [info exists commitrow($curview,$pending_select)] &&
2298 $commitrow($curview,$pending_select) < $numcommits} {
2299 selectline $commitrow($curview,$pending_select) 1
2301 if {![info exists selectedline] && ![info exists pending_select]} {
2306 proc layoutrows {row endrow last} {
2307 global rowidlist rowoffsets displayorder
2308 global uparrowlen downarrowlen maxwidth mingaplen
2309 global childlist parentlist
2310 global idrowranges linesegends
2311 global commitidx curview
2312 global idinlist rowchk rowrangelist
2314 set idlist [lindex $rowidlist $row]
2315 set offs [lindex $rowoffsets $row]
2316 while {$row < $endrow} {
2317 set id [lindex $displayorder $row]
2320 foreach p [lindex $parentlist $row] {
2321 if {![info exists idinlist($p)]} {
2323 } elseif {!$idinlist($p)} {
2328 set nev [expr {[llength $idlist] + [llength $newolds]
2329 + [llength $oldolds] - $maxwidth + 1}]
2332 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2333 for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2334 set i [lindex $idlist $x]
2335 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2336 set r [usedinrange $i [expr {$row - $downarrowlen}] \
2337 [expr {$row + $uparrowlen + $mingaplen}]]
2339 set idlist [lreplace $idlist $x $x]
2340 set offs [lreplace $offs $x $x]
2341 set offs [incrange $offs $x 1]
2343 set rm1 [expr {$row - 1}]
2345 lappend idrowranges($i) $rm1
2346 if {[incr nev -1] <= 0} break
2349 set rowchk($id) [expr {$row + $r}]
2352 lset rowidlist $row $idlist
2353 lset rowoffsets $row $offs
2355 lappend linesegends $lse
2356 set col [lsearch -exact $idlist $id]
2358 set col [llength $idlist]
2360 lset rowidlist $row $idlist
2362 if {[lindex $childlist $row] ne {}} {
2363 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2367 lset rowoffsets $row $offs
2369 makeuparrow $id $col $row $z
2375 if {[info exists idrowranges($id)]} {
2376 set ranges $idrowranges($id)
2378 unset idrowranges($id)
2380 lappend rowrangelist $ranges
2382 set offs [ntimes [llength $idlist] 0]
2383 set l [llength $newolds]
2384 set idlist [eval lreplace \$idlist $col $col $newolds]
2387 set offs [lrange $offs 0 [expr {$col - 1}]]
2388 foreach x $newolds {
2393 set tmp [expr {[llength $idlist] - [llength $offs]}]
2395 set offs [concat $offs [ntimes $tmp $o]]
2400 foreach i $newolds {
2402 set idrowranges($i) $row
2405 foreach oid $oldolds {
2406 set idinlist($oid) 1
2407 set idlist [linsert $idlist $col $oid]
2408 set offs [linsert $offs $col $o]
2409 makeuparrow $oid $col $row $o
2412 lappend rowidlist $idlist
2413 lappend rowoffsets $offs
2418 proc addextraid {id row} {
2419 global displayorder commitrow commitinfo
2420 global commitidx commitlisted
2421 global parentlist childlist children curview
2423 incr commitidx($curview)
2424 lappend displayorder $id
2425 lappend commitlisted 0
2426 lappend parentlist {}
2427 set commitrow($curview,$id) $row
2429 if {![info exists commitinfo($id)]} {
2430 set commitinfo($id) {"No commit information available"}
2432 if {![info exists children($curview,$id)]} {
2433 set children($curview,$id) {}
2435 lappend childlist $children($curview,$id)
2438 proc layouttail {} {
2439 global rowidlist rowoffsets idinlist commitidx curview
2440 global idrowranges rowrangelist
2442 set row $commitidx($curview)
2443 set idlist [lindex $rowidlist $row]
2444 while {$idlist ne {}} {
2445 set col [expr {[llength $idlist] - 1}]
2446 set id [lindex $idlist $col]
2449 lappend idrowranges($id) $row
2450 lappend rowrangelist $idrowranges($id)
2451 unset idrowranges($id)
2453 set offs [ntimes $col 0]
2454 set idlist [lreplace $idlist $col $col]
2455 lappend rowidlist $idlist
2456 lappend rowoffsets $offs
2459 foreach id [array names idinlist] {
2461 lset rowidlist $row [list $id]
2462 lset rowoffsets $row 0
2463 makeuparrow $id 0 $row 0
2464 lappend idrowranges($id) $row
2465 lappend rowrangelist $idrowranges($id)
2466 unset idrowranges($id)
2468 lappend rowidlist {}
2469 lappend rowoffsets {}
2473 proc insert_pad {row col npad} {
2474 global rowidlist rowoffsets
2476 set pad [ntimes $npad {}]
2477 lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2478 set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2479 lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2482 proc optimize_rows {row col endrow} {
2483 global rowidlist rowoffsets idrowranges displayorder
2485 for {} {$row < $endrow} {incr row} {
2486 set idlist [lindex $rowidlist $row]
2487 set offs [lindex $rowoffsets $row]
2489 for {} {$col < [llength $offs]} {incr col} {
2490 if {[lindex $idlist $col] eq {}} {
2494 set z [lindex $offs $col]
2495 if {$z eq {}} continue
2497 set x0 [expr {$col + $z}]
2498 set y0 [expr {$row - 1}]
2499 set z0 [lindex $rowoffsets $y0 $x0]
2501 set id [lindex $idlist $col]
2502 set ranges [rowranges $id]
2503 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2507 if {$z < -1 || ($z < 0 && $isarrow)} {
2508 set npad [expr {-1 - $z + $isarrow}]
2509 set offs [incrange $offs $col $npad]
2510 insert_pad $y0 $x0 $npad
2512 optimize_rows $y0 $x0 $row
2514 set z [lindex $offs $col]
2515 set x0 [expr {$col + $z}]
2516 set z0 [lindex $rowoffsets $y0 $x0]
2517 } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2518 set npad [expr {$z - 1 + $isarrow}]
2519 set y1 [expr {$row + 1}]
2520 set offs2 [lindex $rowoffsets $y1]
2524 if {$z eq {} || $x1 + $z < $col} continue
2525 if {$x1 + $z > $col} {
2528 lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2531 set pad [ntimes $npad {}]
2532 set idlist [eval linsert \$idlist $col $pad]
2533 set tmp [eval linsert \$offs $col $pad]
2535 set offs [incrange $tmp $col [expr {-$npad}]]
2536 set z [lindex $offs $col]
2539 if {$z0 eq {} && !$isarrow} {
2540 # this line links to its first child on row $row-2
2541 set rm2 [expr {$row - 2}]
2542 set id [lindex $displayorder $rm2]
2543 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2545 set z0 [expr {$xc - $x0}]
2548 if {$z0 ne {} && $z < 0 && $z0 > 0} {
2549 insert_pad $y0 $x0 1
2550 set offs [incrange $offs $col 1]
2551 optimize_rows $y0 [expr {$x0 + 1}] $row
2556 for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2557 set o [lindex $offs $col]
2559 # check if this is the link to the first child
2560 set id [lindex $idlist $col]
2561 set ranges [rowranges $id]
2562 if {$ranges ne {} && $row == [lindex $ranges 0]} {
2563 # it is, work out offset to child
2564 set y0 [expr {$row - 1}]
2565 set id [lindex $displayorder $y0]
2566 set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2568 set o [expr {$x0 - $col}]
2572 if {$o eq {} || $o <= 0} break
2574 if {$o ne {} && [incr col] < [llength $idlist]} {
2575 set y1 [expr {$row + 1}]
2576 set offs2 [lindex $rowoffsets $y1]
2580 if {$z eq {} || $x1 + $z < $col} continue
2581 lset rowoffsets $y1 [incrange $offs2 $x1 1]
2584 set idlist [linsert $idlist $col {}]
2585 set tmp [linsert $offs $col {}]
2587 set offs [incrange $tmp $col -1]
2590 lset rowidlist $row $idlist
2591 lset rowoffsets $row $offs
2597 global canvx0 linespc
2598 return [expr {$canvx0 + $col * $linespc}]
2602 global canvy0 linespc
2603 return [expr {$canvy0 + $row * $linespc}]
2606 proc linewidth {id} {
2607 global thickerline lthickness
2610 if {[info exists thickerline] && $id eq $thickerline} {
2611 set wid [expr {2 * $lthickness}]
2616 proc rowranges {id} {
2617 global phase idrowranges commitrow rowlaidout rowrangelist curview
2621 ([info exists commitrow($curview,$id)]
2622 && $commitrow($curview,$id) < $rowlaidout)} {
2623 set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2624 } elseif {[info exists idrowranges($id)]} {
2625 set ranges $idrowranges($id)
2630 proc drawlineseg {id i} {
2631 global rowoffsets rowidlist
2633 global canv colormap linespc
2634 global numcommits commitrow curview
2636 set ranges [rowranges $id]
2638 if {[info exists commitrow($curview,$id)]
2639 && $commitrow($curview,$id) < $numcommits} {
2640 set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2644 set startrow [lindex $ranges [expr {2 * $i}]]
2645 set row [lindex $ranges [expr {2 * $i + 1}]]
2646 if {$startrow == $row} return
2649 set col [lsearch -exact [lindex $rowidlist $row] $id]
2651 puts "oops: drawline: id $id not on row $row"
2657 set o [lindex $rowoffsets $row $col]
2660 # changing direction
2661 set x [xc $row $col]
2663 lappend coords $x $y
2669 set x [xc $row $col]
2671 lappend coords $x $y
2673 # draw the link to the first child as part of this line
2675 set child [lindex $displayorder $row]
2676 set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2678 set x [xc $row $ccol]
2680 if {$ccol < $col - 1} {
2681 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2682 } elseif {$ccol > $col + 1} {
2683 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2685 lappend coords $x $y
2688 if {[llength $coords] < 4} return
2690 # This line has an arrow at the lower end: check if the arrow is
2691 # on a diagonal segment, and if so, work around the Tk 8.4
2692 # refusal to draw arrows on diagonal lines.
2693 set x0 [lindex $coords 0]
2694 set x1 [lindex $coords 2]
2696 set y0 [lindex $coords 1]
2697 set y1 [lindex $coords 3]
2698 if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2699 # we have a nearby vertical segment, just trim off the diag bit
2700 set coords [lrange $coords 2 end]
2702 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2703 set xi [expr {$x0 - $slope * $linespc / 2}]
2704 set yi [expr {$y0 - $linespc / 2}]
2705 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2709 set arrow [expr {2 * ($i > 0) + $downarrow}]
2710 set arrow [lindex {none first last both} $arrow]
2711 set t [$canv create line $coords -width [linewidth $id] \
2712 -fill $colormap($id) -tags lines.$id -arrow $arrow]
2717 proc drawparentlinks {id row col olds} {
2718 global rowidlist canv colormap
2720 set row2 [expr {$row + 1}]
2721 set x [xc $row $col]
2724 set ids [lindex $rowidlist $row2]
2725 # rmx = right-most X coord used
2728 set i [lsearch -exact $ids $p]
2730 puts "oops, parent $p of $id not in list"
2733 set x2 [xc $row2 $i]
2737 set ranges [rowranges $p]
2738 if {$ranges ne {} && $row2 == [lindex $ranges 0]
2739 && $row2 < [lindex $ranges 1]} {
2740 # drawlineseg will do this one for us
2744 # should handle duplicated parents here...
2745 set coords [list $x $y]
2746 if {$i < $col - 1} {
2747 lappend coords [xc $row [expr {$i + 1}]] $y
2748 } elseif {$i > $col + 1} {
2749 lappend coords [xc $row [expr {$i - 1}]] $y
2751 lappend coords $x2 $y2
2752 set t [$canv create line $coords -width [linewidth $p] \
2753 -fill $colormap($p) -tags lines.$p]
2760 proc drawlines {id} {
2761 global colormap canv
2763 global children iddrawn commitrow rowidlist curview
2765 $canv delete lines.$id
2766 set nr [expr {[llength [rowranges $id]] / 2}]
2767 for {set i 0} {$i < $nr} {incr i} {
2768 if {[info exists idrangedrawn($id,$i)]} {
2772 foreach child $children($curview,$id) {
2773 if {[info exists iddrawn($child)]} {
2774 set row $commitrow($curview,$child)
2775 set col [lsearch -exact [lindex $rowidlist $row] $child]
2777 drawparentlinks $child $row $col [list $id]
2783 proc drawcmittext {id row col rmx} {
2784 global linespc canv canv2 canv3 canvy0
2785 global commitlisted commitinfo rowidlist
2786 global rowtextx idpos idtags idheads idotherrefs
2787 global linehtag linentag linedtag
2788 global mainfont canvxmax
2790 set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2791 set x [xc $row $col]
2793 set orad [expr {$linespc / 3}]
2794 set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2795 [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2796 -fill $ofill -outline black -width 1]
2798 $canv bind $t <1> {selcanvline {} %x %y}
2799 set xt [xc $row [llength [lindex $rowidlist $row]]]
2803 set rowtextx($row) $xt
2804 set idpos($id) [list $x $xt $y]
2805 if {[info exists idtags($id)] || [info exists idheads($id)]
2806 || [info exists idotherrefs($id)]} {
2807 set xt [drawtags $id $x $xt $y]
2809 set headline [lindex $commitinfo($id) 0]
2810 set name [lindex $commitinfo($id) 1]
2811 set date [lindex $commitinfo($id) 2]
2812 set date [formatdate $date]
2815 set isbold [ishighlighted $row]
2822 set linehtag($row) [$canv create text $xt $y -anchor w \
2823 -text $headline -font $font]
2824 $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2825 set linentag($row) [$canv2 create text 3 $y -anchor w \
2826 -text $name -font $nfont]
2827 set linedtag($row) [$canv3 create text 3 $y -anchor w \
2828 -text $date -font $mainfont]
2829 set xr [expr {$xt + [font measure $mainfont $headline]}]
2830 if {$xr > $canvxmax} {
2836 proc drawcmitrow {row} {
2837 global displayorder rowidlist
2838 global idrangedrawn iddrawn
2839 global commitinfo parentlist numcommits
2840 global filehighlight fhighlights findstring nhighlights
2841 global hlview vhighlights
2842 global highlight_related rhighlights
2844 if {$row >= $numcommits} return
2845 foreach id [lindex $rowidlist $row] {
2846 if {$id eq {}} continue
2848 foreach {s e} [rowranges $id] {
2850 if {$row < $s} continue
2853 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2855 set idrangedrawn($id,$i) 1
2862 set id [lindex $displayorder $row]
2863 if {[info exists hlview] && ![info exists vhighlights($row)]} {
2864 askvhighlight $row $id
2866 if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
2867 askfilehighlight $row $id
2869 if {$findstring ne {} && ![info exists nhighlights($row)]} {
2870 askfindhighlight $row $id
2872 if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
2873 askrelhighlight $row $id
2875 if {[info exists iddrawn($id)]} return
2876 set col [lsearch -exact [lindex $rowidlist $row] $id]
2878 puts "oops, row $row id $id not in list"
2881 if {![info exists commitinfo($id)]} {
2885 set olds [lindex $parentlist $row]
2887 set rmx [drawparentlinks $id $row $col $olds]
2891 drawcmittext $id $row $col $rmx
2895 proc drawfrac {f0 f1} {
2896 global numcommits canv
2899 set ymax [lindex [$canv cget -scrollregion] 3]
2900 if {$ymax eq {} || $ymax == 0} return
2901 set y0 [expr {int($f0 * $ymax)}]
2902 set row [expr {int(($y0 - 3) / $linespc) - 1}]
2906 set y1 [expr {int($f1 * $ymax)}]
2907 set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
2908 if {$endrow >= $numcommits} {
2909 set endrow [expr {$numcommits - 1}]
2911 for {} {$row <= $endrow} {incr row} {
2916 proc drawvisible {} {
2918 eval drawfrac [$canv yview]
2921 proc clear_display {} {
2922 global iddrawn idrangedrawn
2923 global vhighlights fhighlights nhighlights rhighlights
2926 catch {unset iddrawn}
2927 catch {unset idrangedrawn}
2928 catch {unset vhighlights}
2929 catch {unset fhighlights}
2930 catch {unset nhighlights}
2931 catch {unset rhighlights}
2934 proc findcrossings {id} {
2935 global rowidlist parentlist numcommits rowoffsets displayorder
2939 foreach {s e} [rowranges $id] {
2940 if {$e >= $numcommits} {
2941 set e [expr {$numcommits - 1}]
2943 if {$e <= $s} continue
2944 set x [lsearch -exact [lindex $rowidlist $e] $id]
2946 puts "findcrossings: oops, no [shortids $id] in row $e"
2949 for {set row $e} {[incr row -1] >= $s} {} {
2950 set olds [lindex $parentlist $row]
2951 set kid [lindex $displayorder $row]
2952 set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
2953 if {$kidx < 0} continue
2954 set nextrow [lindex $rowidlist [expr {$row + 1}]]
2956 set px [lsearch -exact $nextrow $p]
2957 if {$px < 0} continue
2958 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
2959 if {[lsearch -exact $ccross $p] >= 0} continue
2960 if {$x == $px + ($kidx < $px? -1: 1)} {
2962 } elseif {[lsearch -exact $cross $p] < 0} {
2967 set inc [lindex $rowoffsets $row $x]
2968 if {$inc eq {}} break
2972 return [concat $ccross {{}} $cross]
2975 proc assigncolor {id} {
2976 global colormap colors nextcolor
2977 global commitrow parentlist children children curview
2979 if {[info exists colormap($id)]} return
2980 set ncolors [llength $colors]
2981 if {[info exists children($curview,$id)]} {
2982 set kids $children($curview,$id)
2986 if {[llength $kids] == 1} {
2987 set child [lindex $kids 0]
2988 if {[info exists colormap($child)]
2989 && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
2990 set colormap($id) $colormap($child)
2996 foreach x [findcrossings $id] {
2998 # delimiter between corner crossings and other crossings
2999 if {[llength $badcolors] >= $ncolors - 1} break
3000 set origbad $badcolors
3002 if {[info exists colormap($x)]
3003 && [lsearch -exact $badcolors $colormap($x)] < 0} {
3004 lappend badcolors $colormap($x)
3007 if {[llength $badcolors] >= $ncolors} {
3008 set badcolors $origbad
3010 set origbad $badcolors
3011 if {[llength $badcolors] < $ncolors - 1} {
3012 foreach child $kids {
3013 if {[info exists colormap($child)]
3014 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3015 lappend badcolors $colormap($child)
3017 foreach p [lindex $parentlist $commitrow($curview,$child)] {
3018 if {[info exists colormap($p)]
3019 && [lsearch -exact $badcolors $colormap($p)] < 0} {
3020 lappend badcolors $colormap($p)
3024 if {[llength $badcolors] >= $ncolors} {
3025 set badcolors $origbad
3028 for {set i 0} {$i <= $ncolors} {incr i} {
3029 set c [lindex $colors $nextcolor]
3030 if {[incr nextcolor] >= $ncolors} {
3033 if {[lsearch -exact $badcolors $c]} break
3035 set colormap($id) $c
3038 proc bindline {t id} {
3041 $canv bind $t <Enter> "lineenter %x %y $id"
3042 $canv bind $t <Motion> "linemotion %x %y $id"
3043 $canv bind $t <Leave> "lineleave $id"
3044 $canv bind $t <Button-1> "lineclick %x %y $id 1"
3047 proc drawtags {id x xt y1} {
3048 global idtags idheads idotherrefs
3049 global linespc lthickness
3050 global canv mainfont commitrow rowtextx curview
3055 if {[info exists idtags($id)]} {
3056 set marks $idtags($id)
3057 set ntags [llength $marks]
3059 if {[info exists idheads($id)]} {
3060 set marks [concat $marks $idheads($id)]
3061 set nheads [llength $idheads($id)]
3063 if {[info exists idotherrefs($id)]} {
3064 set marks [concat $marks $idotherrefs($id)]
3070 set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3071 set yt [expr {$y1 - 0.5 * $linespc}]
3072 set yb [expr {$yt + $linespc - 1}]
3075 foreach tag $marks {
3076 set wid [font measure $mainfont $tag]
3079 set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3081 set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3082 -width $lthickness -fill black -tags tag.$id]
3084 foreach tag $marks x $xvals wid $wvals {
3085 set xl [expr {$x + $delta}]
3086 set xr [expr {$x + $delta + $wid + $lthickness}]
3087 if {[incr ntags -1] >= 0} {
3089 set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3090 $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3091 -width 1 -outline black -fill yellow -tags tag.$id]
3092 $canv bind $t <1> [list showtag $tag 1]
3093 set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3095 # draw a head or other ref
3096 if {[incr nheads -1] >= 0} {
3101 set xl [expr {$xl - $delta/2}]
3102 $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3103 -width 1 -outline black -fill $col -tags tag.$id
3104 if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3105 set rwid [font measure $mainfont $remoteprefix]
3106 set xi [expr {$x + 1}]
3107 set yti [expr {$yt + 1}]
3108 set xri [expr {$x + $rwid}]
3109 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3110 -width 0 -fill "#ffddaa" -tags tag.$id
3113 set t [$canv create text $xl $y1 -anchor w -text $tag \
3114 -font $mainfont -tags tag.$id]
3116 $canv bind $t <1> [list showtag $tag 1]
3122 proc xcoord {i level ln} {
3123 global canvx0 xspc1 xspc2
3125 set x [expr {$canvx0 + $i * $xspc1($ln)}]
3126 if {$i > 0 && $i == $level} {
3127 set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3128 } elseif {$i > $level} {
3129 set x [expr {$x + $xspc2 - $xspc1($ln)}]
3134 proc show_status {msg} {
3135 global canv mainfont
3138 $canv create text 3 3 -anchor nw -text $msg -font $mainfont -tags textitems
3141 proc finishcommits {} {
3142 global commitidx phase curview
3143 global canv mainfont ctext maincursor textcursor
3144 global findinprogress pending_select
3146 if {$commitidx($curview) > 0} {
3149 show_status "No commits selected"
3152 catch {unset pending_select}
3155 # Don't change the text pane cursor if it is currently the hand cursor,
3156 # showing that we are over a sha1 ID link.
3157 proc settextcursor {c} {
3158 global ctext curtextcursor
3160 if {[$ctext cget -cursor] == $curtextcursor} {
3161 $ctext config -cursor $c
3163 set curtextcursor $c
3166 proc nowbusy {what} {
3169 if {[array names isbusy] eq {}} {
3170 . config -cursor watch
3176 proc notbusy {what} {
3177 global isbusy maincursor textcursor
3179 catch {unset isbusy($what)}
3180 if {[array names isbusy] eq {}} {
3181 . config -cursor $maincursor
3182 settextcursor $textcursor
3189 global canvy0 numcommits linespc
3190 global rowlaidout commitidx curview
3191 global pending_select
3194 layoutrows $rowlaidout $commitidx($curview) 1
3196 optimize_rows $row 0 $commitidx($curview)
3197 showstuff $commitidx($curview)
3198 if {[info exists pending_select]} {
3202 set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3203 #puts "overall $drawmsecs ms for $numcommits commits"
3206 proc findmatches {f} {
3207 global findtype foundstring foundstrlen
3208 if {$findtype == "Regexp"} {
3209 set matches [regexp -indices -all -inline $foundstring $f]
3211 if {$findtype == "IgnCase"} {
3212 set str [string tolower $f]
3218 while {[set j [string first $foundstring $str $i]] >= 0} {
3219 lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3220 set i [expr {$j + $foundstrlen}]
3227 global findtype findloc findstring markedmatches commitinfo
3228 global numcommits displayorder linehtag linentag linedtag
3229 global mainfont canv canv2 canv3 selectedline
3230 global matchinglines foundstring foundstrlen matchstring
3236 set matchinglines {}
3237 if {$findtype == "IgnCase"} {
3238 set foundstring [string tolower $findstring]
3240 set foundstring $findstring
3242 set foundstrlen [string length $findstring]
3243 if {$foundstrlen == 0} return
3244 regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3245 set matchstring "*$matchstring*"
3246 if {![info exists selectedline]} {
3249 set oldsel $selectedline
3252 set fldtypes {Headline Author Date Committer CDate Comments}
3254 foreach id $displayorder {
3255 set d $commitdata($id)
3257 if {$findtype == "Regexp"} {
3258 set doesmatch [regexp $foundstring $d]
3259 } elseif {$findtype == "IgnCase"} {
3260 set doesmatch [string match -nocase $matchstring $d]
3262 set doesmatch [string match $matchstring $d]
3264 if {!$doesmatch} continue
3265 if {![info exists commitinfo($id)]} {
3268 set info $commitinfo($id)
3270 foreach f $info ty $fldtypes {
3271 if {$findloc != "All fields" && $findloc != $ty} {
3274 set matches [findmatches $f]
3275 if {$matches == {}} continue
3277 if {$ty == "Headline"} {
3279 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3280 } elseif {$ty == "Author"} {
3282 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3283 } elseif {$ty == "Date"} {
3285 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3289 lappend matchinglines $l
3290 if {!$didsel && $l > $oldsel} {
3296 if {$matchinglines == {}} {
3298 } elseif {!$didsel} {
3299 findselectline [lindex $matchinglines 0]
3303 proc findselectline {l} {
3304 global findloc commentend ctext
3306 if {$findloc == "All fields" || $findloc == "Comments"} {
3307 # highlight the matches in the comments
3308 set f [$ctext get 1.0 $commentend]
3309 set matches [findmatches $f]
3310 foreach match $matches {
3311 set start [lindex $match 0]
3312 set end [expr {[lindex $match 1] + 1}]
3313 $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3318 proc findnext {restart} {
3319 global matchinglines selectedline
3320 if {![info exists matchinglines]} {
3326 if {![info exists selectedline]} return
3327 foreach l $matchinglines {
3328 if {$l > $selectedline} {
3337 global matchinglines selectedline
3338 if {![info exists matchinglines]} {
3342 if {![info exists selectedline]} return
3344 foreach l $matchinglines {
3345 if {$l >= $selectedline} break
3349 findselectline $prev
3355 proc stopfindproc {{done 0}} {
3356 global findprocpid findprocfile findids
3357 global ctext findoldcursor phase maincursor textcursor
3358 global findinprogress
3360 catch {unset findids}
3361 if {[info exists findprocpid]} {
3363 catch {exec kill $findprocpid}
3365 catch {close $findprocfile}
3368 catch {unset findinprogress}
3372 # mark a commit as matching by putting a yellow background
3373 # behind the headline
3374 proc markheadline {l id} {
3375 global canv mainfont linehtag
3378 set bbox [$canv bbox $linehtag($l)]
3379 set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3383 # mark the bits of a headline, author or date that match a find string
3384 proc markmatches {canv l str tag matches font} {
3385 set bbox [$canv bbox $tag]
3386 set x0 [lindex $bbox 0]
3387 set y0 [lindex $bbox 1]
3388 set y1 [lindex $bbox 3]
3389 foreach match $matches {
3390 set start [lindex $match 0]
3391 set end [lindex $match 1]
3392 if {$start > $end} continue
3393 set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3394 set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3395 set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3396 [expr {$x0+$xlen+2}] $y1 \
3397 -outline {} -tags matches -fill yellow]
3402 proc unmarkmatches {} {
3403 global matchinglines findids
3404 allcanvs delete matches
3405 catch {unset matchinglines}
3406 catch {unset findids}
3409 proc selcanvline {w x y} {
3410 global canv canvy0 ctext linespc
3412 set ymax [lindex [$canv cget -scrollregion] 3]
3413 if {$ymax == {}} return
3414 set yfrac [lindex [$canv yview] 0]
3415 set y [expr {$y + $yfrac * $ymax}]
3416 set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3421 if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3427 proc commit_descriptor {p} {
3429 if {![info exists commitinfo($p)]} {
3433 if {[llength $commitinfo($p)] > 1} {
3434 set l [lindex $commitinfo($p) 0]
3439 # append some text to the ctext widget, and make any SHA1 ID
3440 # that we know about be a clickable link.
3441 proc appendwithlinks {text} {
3442 global ctext commitrow linknum curview
3444 set start [$ctext index "end - 1c"]
3445 $ctext insert end $text
3446 $ctext insert end "\n"
3447 set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3451 set linkid [string range $text $s $e]
3452 if {![info exists commitrow($curview,$linkid)]} continue
3454 $ctext tag add link "$start + $s c" "$start + $e c"
3455 $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3456 $ctext tag bind link$linknum <1> \
3457 [list selectline $commitrow($curview,$linkid) 1]
3460 $ctext tag conf link -foreground blue -underline 1
3461 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3462 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3465 proc viewnextline {dir} {
3469 set ymax [lindex [$canv cget -scrollregion] 3]
3470 set wnow [$canv yview]
3471 set wtop [expr {[lindex $wnow 0] * $ymax}]
3472 set newtop [expr {$wtop + $dir * $linespc}]
3475 } elseif {$newtop > $ymax} {
3478 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3481 proc selectline {l isnew} {
3482 global canv canv2 canv3 ctext commitinfo selectedline
3483 global displayorder linehtag linentag linedtag
3484 global canvy0 linespc parentlist childlist
3485 global currentid sha1entry
3486 global commentend idtags linknum
3487 global mergemax numcommits pending_select
3490 catch {unset pending_select}
3493 if {$l < 0 || $l >= $numcommits} return
3494 set y [expr {$canvy0 + $l * $linespc}]
3495 set ymax [lindex [$canv cget -scrollregion] 3]
3496 set ytop [expr {$y - $linespc - 1}]
3497 set ybot [expr {$y + $linespc + 1}]
3498 set wnow [$canv yview]
3499 set wtop [expr {[lindex $wnow 0] * $ymax}]
3500 set wbot [expr {[lindex $wnow 1] * $ymax}]
3501 set wh [expr {$wbot - $wtop}]
3503 if {$ytop < $wtop} {
3504 if {$ybot < $wtop} {
3505 set newtop [expr {$y - $wh / 2.0}]
3508 if {$newtop > $wtop - $linespc} {
3509 set newtop [expr {$wtop - $linespc}]
3512 } elseif {$ybot > $wbot} {
3513 if {$ytop > $wbot} {
3514 set newtop [expr {$y - $wh / 2.0}]
3516 set newtop [expr {$ybot - $wh}]
3517 if {$newtop < $wtop + $linespc} {
3518 set newtop [expr {$wtop + $linespc}]
3522 if {$newtop != $wtop} {
3526 allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3530 if {![info exists linehtag($l)]} return
3532 set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3533 -tags secsel -fill [$canv cget -selectbackground]]
3535 $canv2 delete secsel
3536 set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3537 -tags secsel -fill [$canv2 cget -selectbackground]]
3539 $canv3 delete secsel
3540 set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3541 -tags secsel -fill [$canv3 cget -selectbackground]]
3545 addtohistory [list selectline $l 0]
3550 set id [lindex $displayorder $l]
3552 $sha1entry delete 0 end
3553 $sha1entry insert 0 $id
3554 $sha1entry selection from 0
3555 $sha1entry selection to end
3558 $ctext conf -state normal
3561 set info $commitinfo($id)
3562 set date [formatdate [lindex $info 2]]
3563 $ctext insert end "Author: [lindex $info 1] $date\n"
3564 set date [formatdate [lindex $info 4]]
3565 $ctext insert end "Committer: [lindex $info 3] $date\n"
3566 if {[info exists idtags($id)]} {
3567 $ctext insert end "Tags:"
3568 foreach tag $idtags($id) {
3569 $ctext insert end " $tag"
3571 $ctext insert end "\n"
3575 set olds [lindex $parentlist $l]
3576 if {[llength $olds] > 1} {
3579 if {$np >= $mergemax} {
3584 $ctext insert end "Parent: " $tag
3585 appendwithlinks [commit_descriptor $p]
3590 append comment "Parent: [commit_descriptor $p]\n"
3594 foreach c [lindex $childlist $l] {
3595 append comment "Child: [commit_descriptor $c]\n"
3598 append comment [lindex $info 5]
3600 # make anything that looks like a SHA1 ID be a clickable link
3601 appendwithlinks $comment
3603 $ctext tag delete Comments
3604 $ctext tag remove found 1.0 end
3605 $ctext conf -state disabled
3606 set commentend [$ctext index "end - 1c"]
3608 init_flist "Comments"
3609 if {$cmitmode eq "tree"} {
3611 } elseif {[llength $olds] <= 1} {
3618 proc selfirstline {} {
3623 proc sellastline {} {
3626 set l [expr {$numcommits - 1}]
3630 proc selnextline {dir} {
3632 if {![info exists selectedline]} return
3633 set l [expr {$selectedline + $dir}]
3638 proc selnextpage {dir} {
3639 global canv linespc selectedline numcommits
3641 set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3645 allcanvs yview scroll [expr {$dir * $lpp}] units
3647 if {![info exists selectedline]} return
3648 set l [expr {$selectedline + $dir * $lpp}]
3651 } elseif {$l >= $numcommits} {
3652 set l [expr $numcommits - 1]
3658 proc unselectline {} {
3659 global selectedline currentid
3661 catch {unset selectedline}
3662 catch {unset currentid}
3663 allcanvs delete secsel
3667 proc reselectline {} {
3670 if {[info exists selectedline]} {
3671 selectline $selectedline 0
3675 proc addtohistory {cmd} {
3676 global history historyindex curview
3678 set elt [list $curview $cmd]
3679 if {$historyindex > 0
3680 && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3684 if {$historyindex < [llength $history]} {
3685 set history [lreplace $history $historyindex end $elt]
3687 lappend history $elt
3690 if {$historyindex > 1} {
3691 .ctop.top.bar.leftbut conf -state normal
3693 .ctop.top.bar.leftbut conf -state disabled
3695 .ctop.top.bar.rightbut conf -state disabled
3701 set view [lindex $elt 0]
3702 set cmd [lindex $elt 1]
3703 if {$curview != $view} {
3710 global history historyindex
3712 if {$historyindex > 1} {
3713 incr historyindex -1
3714 godo [lindex $history [expr {$historyindex - 1}]]
3715 .ctop.top.bar.rightbut conf -state normal
3717 if {$historyindex <= 1} {
3718 .ctop.top.bar.leftbut conf -state disabled
3723 global history historyindex
3725 if {$historyindex < [llength $history]} {
3726 set cmd [lindex $history $historyindex]
3729 .ctop.top.bar.leftbut conf -state normal
3731 if {$historyindex >= [llength $history]} {
3732 .ctop.top.bar.rightbut conf -state disabled
3737 global treefilelist treeidlist diffids diffmergeid treepending
3740 catch {unset diffmergeid}
3741 if {![info exists treefilelist($id)]} {
3742 if {![info exists treepending]} {
3743 if {[catch {set gtf [open [concat | git-ls-tree -r $id] r]}]} {
3747 set treefilelist($id) {}
3748 set treeidlist($id) {}
3749 fconfigure $gtf -blocking 0
3750 fileevent $gtf readable [list gettreeline $gtf $id]
3757 proc gettreeline {gtf id} {
3758 global treefilelist treeidlist treepending cmitmode diffids
3760 while {[gets $gtf line] >= 0} {
3761 if {[lindex $line 1] ne "blob"} continue
3762 set sha1 [lindex $line 2]
3763 set fname [lindex $line 3]
3764 lappend treefilelist($id) $fname
3765 lappend treeidlist($id) $sha1
3767 if {![eof $gtf]} return
3770 if {$cmitmode ne "tree"} {
3771 if {![info exists diffmergeid]} {
3772 gettreediffs $diffids
3774 } elseif {$id ne $diffids} {
3782 global treefilelist treeidlist diffids
3783 global ctext commentend
3785 set i [lsearch -exact $treefilelist($diffids) $f]
3787 puts "oops, $f not in list for id $diffids"
3790 set blob [lindex $treeidlist($diffids) $i]
3791 if {[catch {set bf [open [concat | git-cat-file blob $blob] r]} err]} {
3792 puts "oops, error reading blob $blob: $err"
3795 fconfigure $bf -blocking 0
3796 fileevent $bf readable [list getblobline $bf $diffids]
3797 $ctext config -state normal
3798 clear_ctext $commentend
3799 $ctext insert end "\n"
3800 $ctext insert end "$f\n" filesep
3801 $ctext config -state disabled
3802 $ctext yview $commentend
3805 proc getblobline {bf id} {
3806 global diffids cmitmode ctext
3808 if {$id ne $diffids || $cmitmode ne "tree"} {
3812 $ctext config -state normal
3813 while {[gets $bf line] >= 0} {
3814 $ctext insert end "$line\n"
3817 # delete last newline
3818 $ctext delete "end - 2c" "end - 1c"
3821 $ctext config -state disabled
3824 proc mergediff {id l} {
3825 global diffmergeid diffopts mdifffd
3831 # this doesn't seem to actually affect anything...
3832 set env(GIT_DIFF_OPTS) $diffopts
3833 set cmd [concat | git-diff-tree --no-commit-id --cc $id]
3834 if {[catch {set mdf [open $cmd r]} err]} {
3835 error_popup "Error getting merge diffs: $err"
3838 fconfigure $mdf -blocking 0
3839 set mdifffd($id) $mdf
3840 set np [llength [lindex $parentlist $l]]
3841 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3842 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3845 proc getmergediffline {mdf id np} {
3846 global diffmergeid ctext cflist nextupdate mergemax
3847 global difffilestart mdifffd
3849 set n [gets $mdf line]
3856 if {![info exists diffmergeid] || $id != $diffmergeid
3857 || $mdf != $mdifffd($id)} {
3860 $ctext conf -state normal
3861 if {[regexp {^diff --cc (.*)} $line match fname]} {
3862 # start of a new file
3863 $ctext insert end "\n"
3864 set here [$ctext index "end - 1c"]
3865 lappend difffilestart $here
3866 add_flist [list $fname]
3867 set l [expr {(78 - [string length $fname]) / 2}]
3868 set pad [string range "----------------------------------------" 1 $l]
3869 $ctext insert end "$pad $fname $pad\n" filesep
3870 } elseif {[regexp {^@@} $line]} {
3871 $ctext insert end "$line\n" hunksep
3872 } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
3875 # parse the prefix - one ' ', '-' or '+' for each parent
3880 for {set j 0} {$j < $np} {incr j} {
3881 set c [string range $line $j $j]
3884 } elseif {$c == "-"} {
3886 } elseif {$c == "+"} {
3895 if {!$isbad && $minuses ne {} && $pluses eq {}} {
3896 # line doesn't appear in result, parents in $minuses have the line
3897 set num [lindex $minuses 0]
3898 } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
3899 # line appears in result, parents in $pluses don't have the line
3900 lappend tags mresult
3901 set num [lindex $spaces 0]
3904 if {$num >= $mergemax} {
3909 $ctext insert end "$line\n" $tags
3911 $ctext conf -state disabled
3912 if {[clock clicks -milliseconds] >= $nextupdate} {
3914 fileevent $mdf readable {}
3916 fileevent $mdf readable [list getmergediffline $mdf $id $np]
3920 proc startdiff {ids} {
3921 global treediffs diffids treepending diffmergeid
3924 catch {unset diffmergeid}
3925 if {![info exists treediffs($ids)]} {
3926 if {![info exists treepending]} {
3934 proc addtocflist {ids} {
3935 global treediffs cflist
3936 add_flist $treediffs($ids)
3940 proc gettreediffs {ids} {
3941 global treediff treepending
3942 set treepending $ids
3945 {set gdtf [open [concat | git-diff-tree --no-commit-id -r $ids] r]} \
3947 fconfigure $gdtf -blocking 0
3948 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
3951 proc gettreediffline {gdtf ids} {
3952 global treediff treediffs treepending diffids diffmergeid
3955 set n [gets $gdtf line]
3957 if {![eof $gdtf]} return
3959 set treediffs($ids) $treediff
3961 if {$cmitmode eq "tree"} {
3963 } elseif {$ids != $diffids} {
3964 if {![info exists diffmergeid]} {
3965 gettreediffs $diffids
3972 set file [lindex $line 5]
3973 lappend treediff $file
3976 proc getblobdiffs {ids} {
3977 global diffopts blobdifffd diffids env curdifftag curtagstart
3978 global nextupdate diffinhdr treediffs
3980 set env(GIT_DIFF_OPTS) $diffopts
3981 set cmd [concat | git-diff-tree --no-commit-id -r -p -C $ids]
3982 if {[catch {set bdf [open $cmd r]} err]} {
3983 puts "error getting diffs: $err"
3987 fconfigure $bdf -blocking 0
3988 set blobdifffd($ids) $bdf
3989 set curdifftag Comments
3991 fileevent $bdf readable [list getblobdiffline $bdf $diffids]
3992 set nextupdate [expr {[clock clicks -milliseconds] + 100}]
3995 proc setinlist {var i val} {
3998 while {[llength [set $var]] < $i} {
4001 if {[llength [set $var]] == $i} {
4008 proc getblobdiffline {bdf ids} {
4009 global diffids blobdifffd ctext curdifftag curtagstart
4010 global diffnexthead diffnextnote difffilestart
4011 global nextupdate diffinhdr treediffs
4013 set n [gets $bdf line]
4017 if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4018 $ctext tag add $curdifftag $curtagstart end
4023 if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4026 $ctext conf -state normal
4027 if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4028 # start of a new file
4029 $ctext insert end "\n"
4030 $ctext tag add $curdifftag $curtagstart end
4031 set here [$ctext index "end - 1c"]
4032 set curtagstart $here
4034 set i [lsearch -exact $treediffs($ids) $fname]
4036 setinlist difffilestart $i $here
4038 if {$newname ne $fname} {
4039 set i [lsearch -exact $treediffs($ids) $newname]
4041 setinlist difffilestart $i $here
4044 set curdifftag "f:$fname"
4045 $ctext tag delete $curdifftag
4046 set l [expr {(78 - [string length $header]) / 2}]
4047 set pad [string range "----------------------------------------" 1 $l]
4048 $ctext insert end "$pad $header $pad\n" filesep
4050 } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4052 } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4054 } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4055 $line match f1l f1c f2l f2c rest]} {
4056 $ctext insert end "$line\n" hunksep
4059 set x [string range $line 0 0]
4060 if {$x == "-" || $x == "+"} {
4061 set tag [expr {$x == "+"}]
4062 $ctext insert end "$line\n" d$tag
4063 } elseif {$x == " "} {
4064 $ctext insert end "$line\n"
4065 } elseif {$diffinhdr || $x == "\\"} {
4066 # e.g. "\ No newline at end of file"
4067 $ctext insert end "$line\n" filesep
4069 # Something else we don't recognize
4070 if {$curdifftag != "Comments"} {
4071 $ctext insert end "\n"
4072 $ctext tag add $curdifftag $curtagstart end
4073 set curtagstart [$ctext index "end - 1c"]
4074 set curdifftag Comments
4076 $ctext insert end "$line\n" filesep
4079 $ctext conf -state disabled
4080 if {[clock clicks -milliseconds] >= $nextupdate} {
4082 fileevent $bdf readable {}
4084 fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4089 global difffilestart ctext
4090 set here [$ctext index @0,0]
4091 foreach loc $difffilestart {
4092 if {[$ctext compare $loc > $here]} {
4098 proc clear_ctext {{first 1.0}} {
4099 global ctext smarktop smarkbot
4101 set l [lindex [split $first .] 0]
4102 if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4105 if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4108 $ctext delete $first end
4111 proc incrsearch {name ix op} {
4112 global ctext searchstring searchdirn
4114 $ctext tag remove found 1.0 end
4115 if {[catch {$ctext index anchor}]} {
4116 # no anchor set, use start of selection, or of visible area
4117 set sel [$ctext tag ranges sel]
4119 $ctext mark set anchor [lindex $sel 0]
4120 } elseif {$searchdirn eq "-forwards"} {
4121 $ctext mark set anchor @0,0
4123 $ctext mark set anchor @0,[winfo height $ctext]
4126 if {$searchstring ne {}} {
4127 set here [$ctext search $searchdirn -- $searchstring anchor]
4136 global sstring ctext searchstring searchdirn
4139 $sstring icursor end
4140 set searchdirn -forwards
4141 if {$searchstring ne {}} {
4142 set sel [$ctext tag ranges sel]
4144 set start "[lindex $sel 0] + 1c"
4145 } elseif {[catch {set start [$ctext index anchor]}]} {
4148 set match [$ctext search -count mlen -- $searchstring $start]
4149 $ctext tag remove sel 1.0 end
4155 set mend "$match + $mlen c"
4156 $ctext tag add sel $match $mend
4157 $ctext mark unset anchor
4161 proc dosearchback {} {
4162 global sstring ctext searchstring searchdirn
4165 $sstring icursor end
4166 set searchdirn -backwards
4167 if {$searchstring ne {}} {
4168 set sel [$ctext tag ranges sel]
4170 set start [lindex $sel 0]
4171 } elseif {[catch {set start [$ctext index anchor]}]} {
4172 set start @0,[winfo height $ctext]
4174 set match [$ctext search -backwards -count ml -- $searchstring $start]
4175 $ctext tag remove sel 1.0 end
4181 set mend "$match + $ml c"
4182 $ctext tag add sel $match $mend
4183 $ctext mark unset anchor
4187 proc searchmark {first last} {
4188 global ctext searchstring
4192 set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4193 if {$match eq {}} break
4194 set mend "$match + $mlen c"
4195 $ctext tag add found $match $mend
4199 proc searchmarkvisible {doall} {
4200 global ctext smarktop smarkbot
4202 set topline [lindex [split [$ctext index @0,0] .] 0]
4203 set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4204 if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4205 # no overlap with previous
4206 searchmark $topline $botline
4207 set smarktop $topline
4208 set smarkbot $botline
4210 if {$topline < $smarktop} {
4211 searchmark $topline [expr {$smarktop-1}]
4212 set smarktop $topline
4214 if {$botline > $smarkbot} {
4215 searchmark [expr {$smarkbot+1}] $botline
4216 set smarkbot $botline
4221 proc scrolltext {f0 f1} {
4224 .ctop.cdet.left.sb set $f0 $f1
4225 if {$searchstring ne {}} {
4231 global linespc charspc canvx0 canvy0 mainfont
4232 global xspc1 xspc2 lthickness
4234 set linespc [font metrics $mainfont -linespace]
4235 set charspc [font measure $mainfont "m"]
4236 set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4237 set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4238 set lthickness [expr {int($linespc / 9) + 1}]
4239 set xspc1(0) $linespc
4247 set ymax [lindex [$canv cget -scrollregion] 3]
4248 if {$ymax eq {} || $ymax == 0} return
4249 set span [$canv yview]
4252 allcanvs yview moveto [lindex $span 0]
4254 if {[info exists selectedline]} {
4255 selectline $selectedline 0
4259 proc incrfont {inc} {
4260 global mainfont textfont ctext canv phase
4261 global stopped entries
4263 set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4264 set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4266 $ctext conf -font $textfont
4267 $ctext tag conf filesep -font [concat $textfont bold]
4268 foreach e $entries {
4269 $e conf -font $mainfont
4271 if {$phase eq "getcommits"} {
4272 $canv itemconf textitems -font $mainfont
4278 global sha1entry sha1string
4279 if {[string length $sha1string] == 40} {
4280 $sha1entry delete 0 end
4284 proc sha1change {n1 n2 op} {
4285 global sha1string currentid sha1but
4286 if {$sha1string == {}
4287 || ([info exists currentid] && $sha1string == $currentid)} {
4292 if {[$sha1but cget -state] == $state} return
4293 if {$state == "normal"} {
4294 $sha1but conf -state normal -relief raised -text "Goto: "
4296 $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4300 proc gotocommit {} {
4301 global sha1string currentid commitrow tagids headids
4302 global displayorder numcommits curview
4304 if {$sha1string == {}
4305 || ([info exists currentid] && $sha1string == $currentid)} return
4306 if {[info exists tagids($sha1string)]} {
4307 set id $tagids($sha1string)
4308 } elseif {[info exists headids($sha1string)]} {
4309 set id $headids($sha1string)
4311 set id [string tolower $sha1string]
4312 if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4314 foreach i $displayorder {
4315 if {[string match $id* $i]} {
4319 if {$matches ne {}} {
4320 if {[llength $matches] > 1} {
4321 error_popup "Short SHA1 id $id is ambiguous"
4324 set id [lindex $matches 0]
4328 if {[info exists commitrow($curview,$id)]} {
4329 selectline $commitrow($curview,$id) 1
4332 if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4337 error_popup "$type $sha1string is not known"
4340 proc lineenter {x y id} {
4341 global hoverx hovery hoverid hovertimer
4342 global commitinfo canv
4344 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4348 if {[info exists hovertimer]} {
4349 after cancel $hovertimer
4351 set hovertimer [after 500 linehover]
4355 proc linemotion {x y id} {
4356 global hoverx hovery hoverid hovertimer
4358 if {[info exists hoverid] && $id == $hoverid} {
4361 if {[info exists hovertimer]} {
4362 after cancel $hovertimer
4364 set hovertimer [after 500 linehover]
4368 proc lineleave {id} {
4369 global hoverid hovertimer canv
4371 if {[info exists hoverid] && $id == $hoverid} {
4373 if {[info exists hovertimer]} {
4374 after cancel $hovertimer
4382 global hoverx hovery hoverid hovertimer
4383 global canv linespc lthickness
4384 global commitinfo mainfont
4386 set text [lindex $commitinfo($hoverid) 0]
4387 set ymax [lindex [$canv cget -scrollregion] 3]
4388 if {$ymax == {}} return
4389 set yfrac [lindex [$canv yview] 0]
4390 set x [expr {$hoverx + 2 * $linespc}]
4391 set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4392 set x0 [expr {$x - 2 * $lthickness}]
4393 set y0 [expr {$y - 2 * $lthickness}]
4394 set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4395 set y1 [expr {$y + $linespc + 2 * $lthickness}]
4396 set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4397 -fill \#ffff80 -outline black -width 1 -tags hover]
4399 set t [$canv create text $x $y -anchor nw -text $text -tags hover -font $mainfont]
4403 proc clickisonarrow {id y} {
4406 set ranges [rowranges $id]
4407 set thresh [expr {2 * $lthickness + 6}]
4408 set n [expr {[llength $ranges] - 1}]
4409 for {set i 1} {$i < $n} {incr i} {
4410 set row [lindex $ranges $i]
4411 if {abs([yc $row] - $y) < $thresh} {
4418 proc arrowjump {id n y} {
4421 # 1 <-> 2, 3 <-> 4, etc...
4422 set n [expr {(($n - 1) ^ 1) + 1}]
4423 set row [lindex [rowranges $id] $n]
4425 set ymax [lindex [$canv cget -scrollregion] 3]
4426 if {$ymax eq {} || $ymax <= 0} return
4427 set view [$canv yview]
4428 set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4429 set yfrac [expr {$yt / $ymax - $yspan / 2}]
4433 allcanvs yview moveto $yfrac
4436 proc lineclick {x y id isnew} {
4437 global ctext commitinfo children canv thickerline curview
4439 if {![info exists commitinfo($id)] && ![getcommit $id]} return
4444 # draw this line thicker than normal
4448 set ymax [lindex [$canv cget -scrollregion] 3]
4449 if {$ymax eq {}} return
4450 set yfrac [lindex [$canv yview] 0]
4451 set y [expr {$y + $yfrac * $ymax}]
4453 set dirn [clickisonarrow $id $y]
4455 arrowjump $id $dirn $y
4460 addtohistory [list lineclick $x $y $id 0]
4462 # fill the details pane with info about this line
4463 $ctext conf -state normal
4465 $ctext tag conf link -foreground blue -underline 1
4466 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4467 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4468 $ctext insert end "Parent:\t"
4469 $ctext insert end $id [list link link0]
4470 $ctext tag bind link0 <1> [list selbyid $id]
4471 set info $commitinfo($id)
4472 $ctext insert end "\n\t[lindex $info 0]\n"
4473 $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4474 set date [formatdate [lindex $info 2]]
4475 $ctext insert end "\tDate:\t$date\n"
4476 set kids $children($curview,$id)
4478 $ctext insert end "\nChildren:"
4480 foreach child $kids {
4482 if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4483 set info $commitinfo($child)
4484 $ctext insert end "\n\t"
4485 $ctext insert end $child [list link link$i]
4486 $ctext tag bind link$i <1> [list selbyid $child]
4487 $ctext insert end "\n\t[lindex $info 0]"
4488 $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4489 set date [formatdate [lindex $info 2]]
4490 $ctext insert end "\n\tDate:\t$date\n"
4493 $ctext conf -state disabled
4497 proc normalline {} {
4499 if {[info exists thickerline]} {
4507 global commitrow curview
4508 if {[info exists commitrow($curview,$id)]} {
4509 selectline $commitrow($curview,$id) 1
4515 if {![info exists startmstime]} {
4516 set startmstime [clock clicks -milliseconds]
4518 return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4521 proc rowmenu {x y id} {
4522 global rowctxmenu commitrow selectedline rowmenuid curview
4524 if {![info exists selectedline]
4525 || $commitrow($curview,$id) eq $selectedline} {
4530 $rowctxmenu entryconfigure 0 -state $state
4531 $rowctxmenu entryconfigure 1 -state $state
4532 $rowctxmenu entryconfigure 2 -state $state
4534 tk_popup $rowctxmenu $x $y
4537 proc diffvssel {dirn} {
4538 global rowmenuid selectedline displayorder
4540 if {![info exists selectedline]} return
4542 set oldid [lindex $displayorder $selectedline]
4543 set newid $rowmenuid
4545 set oldid $rowmenuid
4546 set newid [lindex $displayorder $selectedline]
4548 addtohistory [list doseldiff $oldid $newid]
4549 doseldiff $oldid $newid
4552 proc doseldiff {oldid newid} {
4556 $ctext conf -state normal
4559 $ctext insert end "From "
4560 $ctext tag conf link -foreground blue -underline 1
4561 $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4562 $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4563 $ctext tag bind link0 <1> [list selbyid $oldid]
4564 $ctext insert end $oldid [list link link0]
4565 $ctext insert end "\n "
4566 $ctext insert end [lindex $commitinfo($oldid) 0]
4567 $ctext insert end "\n\nTo "
4568 $ctext tag bind link1 <1> [list selbyid $newid]
4569 $ctext insert end $newid [list link link1]
4570 $ctext insert end "\n "
4571 $ctext insert end [lindex $commitinfo($newid) 0]
4572 $ctext insert end "\n"
4573 $ctext conf -state disabled
4574 $ctext tag delete Comments
4575 $ctext tag remove found 1.0 end
4576 startdiff [list $oldid $newid]
4580 global rowmenuid currentid commitinfo patchtop patchnum
4582 if {![info exists currentid]} return
4583 set oldid $currentid
4584 set oldhead [lindex $commitinfo($oldid) 0]
4585 set newid $rowmenuid
4586 set newhead [lindex $commitinfo($newid) 0]
4589 catch {destroy $top}
4591 label $top.title -text "Generate patch"
4592 grid $top.title - -pady 10
4593 label $top.from -text "From:"
4594 entry $top.fromsha1 -width 40 -relief flat
4595 $top.fromsha1 insert 0 $oldid
4596 $top.fromsha1 conf -state readonly
4597 grid $top.from $top.fromsha1 -sticky w
4598 entry $top.fromhead -width 60 -relief flat
4599 $top.fromhead insert 0 $oldhead
4600 $top.fromhead conf -state readonly
4601 grid x $top.fromhead -sticky w
4602 label $top.to -text "To:"
4603 entry $top.tosha1 -width 40 -relief flat
4604 $top.tosha1 insert 0 $newid
4605 $top.tosha1 conf -state readonly
4606 grid $top.to $top.tosha1 -sticky w
4607 entry $top.tohead -width 60 -relief flat
4608 $top.tohead insert 0 $newhead
4609 $top.tohead conf -state readonly
4610 grid x $top.tohead -sticky w
4611 button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4612 grid $top.rev x -pady 10
4613 label $top.flab -text "Output file:"
4614 entry $top.fname -width 60
4615 $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4617 grid $top.flab $top.fname -sticky w
4619 button $top.buts.gen -text "Generate" -command mkpatchgo
4620 button $top.buts.can -text "Cancel" -command mkpatchcan
4621 grid $top.buts.gen $top.buts.can
4622 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4623 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4624 grid $top.buts - -pady 10 -sticky ew
4628 proc mkpatchrev {} {
4631 set oldid [$patchtop.fromsha1 get]
4632 set oldhead [$patchtop.fromhead get]
4633 set newid [$patchtop.tosha1 get]
4634 set newhead [$patchtop.tohead get]
4635 foreach e [list fromsha1 fromhead tosha1 tohead] \
4636 v [list $newid $newhead $oldid $oldhead] {
4637 $patchtop.$e conf -state normal
4638 $patchtop.$e delete 0 end
4639 $patchtop.$e insert 0 $v
4640 $patchtop.$e conf -state readonly
4647 set oldid [$patchtop.fromsha1 get]
4648 set newid [$patchtop.tosha1 get]
4649 set fname [$patchtop.fname get]
4650 if {[catch {exec git-diff-tree -p $oldid $newid >$fname &} err]} {
4651 error_popup "Error creating patch: $err"
4653 catch {destroy $patchtop}
4657 proc mkpatchcan {} {
4660 catch {destroy $patchtop}
4665 global rowmenuid mktagtop commitinfo
4669 catch {destroy $top}
4671 label $top.title -text "Create tag"
4672 grid $top.title - -pady 10
4673 label $top.id -text "ID:"
4674 entry $top.sha1 -width 40 -relief flat
4675 $top.sha1 insert 0 $rowmenuid
4676 $top.sha1 conf -state readonly
4677 grid $top.id $top.sha1 -sticky w
4678 entry $top.head -width 60 -relief flat
4679 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4680 $top.head conf -state readonly
4681 grid x $top.head -sticky w
4682 label $top.tlab -text "Tag name:"
4683 entry $top.tag -width 60
4684 grid $top.tlab $top.tag -sticky w
4686 button $top.buts.gen -text "Create" -command mktaggo
4687 button $top.buts.can -text "Cancel" -command mktagcan
4688 grid $top.buts.gen $top.buts.can
4689 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4690 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4691 grid $top.buts - -pady 10 -sticky ew
4696 global mktagtop env tagids idtags
4698 set id [$mktagtop.sha1 get]
4699 set tag [$mktagtop.tag get]
4701 error_popup "No tag name specified"
4704 if {[info exists tagids($tag)]} {
4705 error_popup "Tag \"$tag\" already exists"
4710 set fname [file join $dir "refs/tags" $tag]
4711 set f [open $fname w]
4715 error_popup "Error creating tag: $err"
4719 set tagids($tag) $id
4720 lappend idtags($id) $tag
4724 proc redrawtags {id} {
4725 global canv linehtag commitrow idpos selectedline curview
4727 if {![info exists commitrow($curview,$id)]} return
4728 drawcmitrow $commitrow($curview,$id)
4729 $canv delete tag.$id
4730 set xt [eval drawtags $id $idpos($id)]
4731 $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4732 if {[info exists selectedline]
4733 && $selectedline == $commitrow($curview,$id)} {
4734 selectline $selectedline 0
4741 catch {destroy $mktagtop}
4750 proc writecommit {} {
4751 global rowmenuid wrcomtop commitinfo wrcomcmd
4753 set top .writecommit
4755 catch {destroy $top}
4757 label $top.title -text "Write commit to file"
4758 grid $top.title - -pady 10
4759 label $top.id -text "ID:"
4760 entry $top.sha1 -width 40 -relief flat
4761 $top.sha1 insert 0 $rowmenuid
4762 $top.sha1 conf -state readonly
4763 grid $top.id $top.sha1 -sticky w
4764 entry $top.head -width 60 -relief flat
4765 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4766 $top.head conf -state readonly
4767 grid x $top.head -sticky w
4768 label $top.clab -text "Command:"
4769 entry $top.cmd -width 60 -textvariable wrcomcmd
4770 grid $top.clab $top.cmd -sticky w -pady 10
4771 label $top.flab -text "Output file:"
4772 entry $top.fname -width 60
4773 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
4774 grid $top.flab $top.fname -sticky w
4776 button $top.buts.gen -text "Write" -command wrcomgo
4777 button $top.buts.can -text "Cancel" -command wrcomcan
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
4788 set id [$wrcomtop.sha1 get]
4789 set cmd "echo $id | [$wrcomtop.cmd get]"
4790 set fname [$wrcomtop.fname get]
4791 if {[catch {exec sh -c $cmd >$fname &} err]} {
4792 error_popup "Error writing commit: $err"
4794 catch {destroy $wrcomtop}
4801 catch {destroy $wrcomtop}
4805 proc listrefs {id} {
4806 global idtags idheads idotherrefs
4809 if {[info exists idtags($id)]} {
4813 if {[info exists idheads($id)]} {
4817 if {[info exists idotherrefs($id)]} {
4818 set z $idotherrefs($id)
4820 return [list $x $y $z]
4823 proc rereadrefs {} {
4824 global idtags idheads idotherrefs
4826 set refids [concat [array names idtags] \
4827 [array names idheads] [array names idotherrefs]]
4828 foreach id $refids {
4829 if {![info exists ref($id)]} {
4830 set ref($id) [listrefs $id]
4834 set refids [lsort -unique [concat $refids [array names idtags] \
4835 [array names idheads] [array names idotherrefs]]]
4836 foreach id $refids {
4837 set v [listrefs $id]
4838 if {![info exists ref($id)] || $ref($id) != $v} {
4844 proc showtag {tag isnew} {
4845 global ctext tagcontents tagids linknum
4848 addtohistory [list showtag $tag 0]
4850 $ctext conf -state normal
4853 if {[info exists tagcontents($tag)]} {
4854 set text $tagcontents($tag)
4856 set text "Tag: $tag\nId: $tagids($tag)"
4858 appendwithlinks $text
4859 $ctext conf -state disabled
4870 global maxwidth maxgraphpct diffopts
4871 global oldprefs prefstop
4875 if {[winfo exists $top]} {
4879 foreach v {maxwidth maxgraphpct diffopts} {
4880 set oldprefs($v) [set $v]
4883 wm title $top "Gitk preferences"
4884 label $top.ldisp -text "Commit list display options"
4885 grid $top.ldisp - -sticky w -pady 10
4886 label $top.spacer -text " "
4887 label $top.maxwidthl -text "Maximum graph width (lines)" \
4889 spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
4890 grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
4891 label $top.maxpctl -text "Maximum graph width (% of pane)" \
4893 spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
4894 grid x $top.maxpctl $top.maxpct -sticky w
4895 label $top.ddisp -text "Diff display options"
4896 grid $top.ddisp - -sticky w -pady 10
4897 label $top.diffoptl -text "Options for diff program" \
4899 entry $top.diffopt -width 20 -textvariable diffopts
4900 grid x $top.diffoptl $top.diffopt -sticky w
4902 button $top.buts.ok -text "OK" -command prefsok
4903 button $top.buts.can -text "Cancel" -command prefscan
4904 grid $top.buts.ok $top.buts.can
4905 grid columnconfigure $top.buts 0 -weight 1 -uniform a
4906 grid columnconfigure $top.buts 1 -weight 1 -uniform a
4907 grid $top.buts - - -pady 10 -sticky ew
4911 global maxwidth maxgraphpct diffopts
4912 global oldprefs prefstop
4914 foreach v {maxwidth maxgraphpct diffopts} {
4915 set $v $oldprefs($v)
4917 catch {destroy $prefstop}
4922 global maxwidth maxgraphpct
4923 global oldprefs prefstop
4925 catch {destroy $prefstop}
4927 if {$maxwidth != $oldprefs(maxwidth)
4928 || $maxgraphpct != $oldprefs(maxgraphpct)} {
4933 proc formatdate {d} {
4934 return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
4937 # This list of encoding names and aliases is distilled from
4938 # http://www.iana.org/assignments/character-sets.
4939 # Not all of them are supported by Tcl.
4940 set encoding_aliases {
4941 { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
4942 ISO646-US US-ASCII us IBM367 cp367 csASCII }
4943 { ISO-10646-UTF-1 csISO10646UTF1 }
4944 { ISO_646.basic:1983 ref csISO646basic1983 }
4945 { INVARIANT csINVARIANT }
4946 { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
4947 { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
4948 { NATS-SEFI iso-ir-8-1 csNATSSEFI }
4949 { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
4950 { NATS-DANO iso-ir-9-1 csNATSDANO }
4951 { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
4952 { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
4953 { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
4954 { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
4955 { ISO-2022-KR csISO2022KR }
4957 { ISO-2022-JP csISO2022JP }
4958 { ISO-2022-JP-2 csISO2022JP2 }
4959 { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
4961 { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
4962 { IT iso-ir-15 ISO646-IT csISO15Italian }
4963 { PT iso-ir-16 ISO646-PT csISO16Portuguese }
4964 { ES iso-ir-17 ISO646-ES csISO17Spanish }
4965 { greek7-old iso-ir-18 csISO18Greek7Old }
4966 { latin-greek iso-ir-19 csISO19LatinGreek }
4967 { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
4968 { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
4969 { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
4970 { ISO_5427 iso-ir-37 csISO5427Cyrillic }
4971 { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
4972 { BS_viewdata iso-ir-47 csISO47BSViewdata }
4973 { INIS iso-ir-49 csISO49INIS }
4974 { INIS-8 iso-ir-50 csISO50INIS8 }
4975 { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
4976 { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
4977 { ISO_5428:1980 iso-ir-55 csISO5428Greek }
4978 { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
4979 { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
4980 { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
4982 { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
4983 { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
4984 { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
4985 { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
4986 { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
4987 { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
4988 { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
4989 { greek7 iso-ir-88 csISO88Greek7 }
4990 { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
4991 { iso-ir-90 csISO90 }
4992 { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
4993 { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
4994 csISO92JISC62991984b }
4995 { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
4996 { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
4997 { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
4998 csISO95JIS62291984handadd }
4999 { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5000 { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5001 { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5002 { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5004 { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5005 { T.61-7bit iso-ir-102 csISO102T617bit }
5006 { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5007 { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5008 { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5009 { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5010 { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5011 { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5012 { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5013 { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5014 arabic csISOLatinArabic }
5015 { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5016 { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5017 { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5018 greek greek8 csISOLatinGreek }
5019 { T.101-G2 iso-ir-128 csISO128T101G2 }
5020 { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5022 { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5023 { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5024 { CSN_369103 iso-ir-139 csISO139CSN369103 }
5025 { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5026 { ISO_6937-2-add iso-ir-142 csISOTextComm }
5027 { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5028 { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5029 csISOLatinCyrillic }
5030 { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5031 { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5032 { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5033 { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5034 { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5035 { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5036 { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5037 { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5038 { ISO_10367-box iso-ir-155 csISO10367Box }
5039 { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5040 { latin-lap lap iso-ir-158 csISO158Lap }
5041 { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5042 { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5045 { JIS_X0201 X0201 csHalfWidthKatakana }
5046 { KSC5636 ISO646-KR csKSC5636 }
5047 { ISO-10646-UCS-2 csUnicode }
5048 { ISO-10646-UCS-4 csUCS4 }
5049 { DEC-MCS dec csDECMCS }
5050 { hp-roman8 roman8 r8 csHPRoman8 }
5051 { macintosh mac csMacintosh }
5052 { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5054 { IBM038 EBCDIC-INT cp038 csIBM038 }
5055 { IBM273 CP273 csIBM273 }
5056 { IBM274 EBCDIC-BE CP274 csIBM274 }
5057 { IBM275 EBCDIC-BR cp275 csIBM275 }
5058 { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5059 { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5060 { IBM280 CP280 ebcdic-cp-it csIBM280 }
5061 { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5062 { IBM284 CP284 ebcdic-cp-es csIBM284 }
5063 { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5064 { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5065 { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5066 { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5067 { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5068 { IBM424 cp424 ebcdic-cp-he csIBM424 }
5069 { IBM437 cp437 437 csPC8CodePage437 }
5070 { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5071 { IBM775 cp775 csPC775Baltic }
5072 { IBM850 cp850 850 csPC850Multilingual }
5073 { IBM851 cp851 851 csIBM851 }
5074 { IBM852 cp852 852 csPCp852 }
5075 { IBM855 cp855 855 csIBM855 }
5076 { IBM857 cp857 857 csIBM857 }
5077 { IBM860 cp860 860 csIBM860 }
5078 { IBM861 cp861 861 cp-is csIBM861 }
5079 { IBM862 cp862 862 csPC862LatinHebrew }
5080 { IBM863 cp863 863 csIBM863 }
5081 { IBM864 cp864 csIBM864 }
5082 { IBM865 cp865 865 csIBM865 }
5083 { IBM866 cp866 866 csIBM866 }
5084 { IBM868 CP868 cp-ar csIBM868 }
5085 { IBM869 cp869 869 cp-gr csIBM869 }
5086 { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5087 { IBM871 CP871 ebcdic-cp-is csIBM871 }
5088 { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5089 { IBM891 cp891 csIBM891 }
5090 { IBM903 cp903 csIBM903 }
5091 { IBM904 cp904 904 csIBBM904 }
5092 { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5093 { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5094 { IBM1026 CP1026 csIBM1026 }
5095 { EBCDIC-AT-DE csIBMEBCDICATDE }
5096 { EBCDIC-AT-DE-A csEBCDICATDEA }
5097 { EBCDIC-CA-FR csEBCDICCAFR }
5098 { EBCDIC-DK-NO csEBCDICDKNO }
5099 { EBCDIC-DK-NO-A csEBCDICDKNOA }
5100 { EBCDIC-FI-SE csEBCDICFISE }
5101 { EBCDIC-FI-SE-A csEBCDICFISEA }
5102 { EBCDIC-FR csEBCDICFR }
5103 { EBCDIC-IT csEBCDICIT }
5104 { EBCDIC-PT csEBCDICPT }
5105 { EBCDIC-ES csEBCDICES }
5106 { EBCDIC-ES-A csEBCDICESA }
5107 { EBCDIC-ES-S csEBCDICESS }
5108 { EBCDIC-UK csEBCDICUK }
5109 { EBCDIC-US csEBCDICUS }
5110 { UNKNOWN-8BIT csUnknown8BiT }
5111 { MNEMONIC csMnemonic }
5116 { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5117 { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5118 { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5119 { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5120 { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5121 { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5122 { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5123 { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5124 { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5125 { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5126 { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5127 { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5128 { IBM1047 IBM-1047 }
5129 { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5130 { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5131 { UNICODE-1-1 csUnicode11 }
5134 { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5135 { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5137 { ISO-8859-15 ISO_8859-15 Latin-9 }
5138 { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5139 { GBK CP936 MS936 windows-936 }
5140 { JIS_Encoding csJISEncoding }
5141 { Shift_JIS MS_Kanji csShiftJIS }
5142 { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5144 { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5145 { ISO-10646-UCS-Basic csUnicodeASCII }
5146 { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5147 { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5148 { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5149 { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5150 { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5151 { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5152 { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5153 { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5154 { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5155 { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5156 { Adobe-Standard-Encoding csAdobeStandardEncoding }
5157 { Ventura-US csVenturaUS }
5158 { Ventura-International csVenturaInternational }
5159 { PC8-Danish-Norwegian csPC8DanishNorwegian }
5160 { PC8-Turkish csPC8Turkish }
5161 { IBM-Symbols csIBMSymbols }
5162 { IBM-Thai csIBMThai }
5163 { HP-Legal csHPLegal }
5164 { HP-Pi-font csHPPiFont }
5165 { HP-Math8 csHPMath8 }
5166 { Adobe-Symbol-Encoding csHPPSMath }
5167 { HP-DeskTop csHPDesktop }
5168 { Ventura-Math csVenturaMath }
5169 { Microsoft-Publishing csMicrosoftPublishing }
5170 { Windows-31J csWindows31J }
5175 proc tcl_encoding {enc} {
5176 global encoding_aliases
5177 set names [encoding names]
5178 set lcnames [string tolower $names]
5179 set enc [string tolower $enc]
5180 set i [lsearch -exact $lcnames $enc]
5182 # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5183 if {[regsub {^iso[-_]} $enc iso encx]} {
5184 set i [lsearch -exact $lcnames $encx]
5188 foreach l $encoding_aliases {
5189 set ll [string tolower $l]
5190 if {[lsearch -exact $ll $enc] < 0} continue
5191 # look through the aliases for one that tcl knows about
5193 set i [lsearch -exact $lcnames $e]
5195 if {[regsub {^iso[-_]} $e iso ex]} {
5196 set i [lsearch -exact $lcnames $ex]
5205 return [lindex $names $i]
5212 set diffopts "-U 5 -p"
5213 set wrcomcmd "git-diff-tree --stdin -p --pretty"
5217 set gitencoding [exec git-repo-config --get i18n.commitencoding]
5219 if {$gitencoding == ""} {
5220 set gitencoding "utf-8"
5222 set tclencoding [tcl_encoding $gitencoding]
5223 if {$tclencoding == {}} {
5224 puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5227 set mainfont {Helvetica 9}
5228 set textfont {Courier 9}
5229 set uifont {Helvetica 9 bold}
5230 set findmergefiles 0
5238 set cmitmode "patch"
5240 set colors {green red blue magenta darkgrey brown orange}
5242 catch {source ~/.gitk}
5244 font create optionfont -family sans-serif -size -12
5248 switch -regexp -- $arg {
5250 "^-d" { set datemode 1 }
5252 lappend revtreeargs $arg
5257 # check that we can find a .git directory somewhere...
5259 if {![file isdirectory $gitdir]} {
5260 show_error . "Cannot find the git directory \"$gitdir\"."
5264 set cmdline_files {}
5265 set i [lsearch -exact $revtreeargs "--"]
5267 set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5268 set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5269 } elseif {$revtreeargs ne {}} {
5271 set f [eval exec git-rev-parse --no-revs --no-flags $revtreeargs]
5272 set cmdline_files [split $f "\n"]
5273 set n [llength $cmdline_files]
5274 set revtreeargs [lrange $revtreeargs 0 end-$n]
5276 # unfortunately we get both stdout and stderr in $err,
5277 # so look for "fatal:".
5278 set i [string first "fatal:" $err]
5280 set err [string range [expr {$i + 6}] end]
5282 show_error . "Bad arguments to gitk:\n$err"
5291 set highlight_paths {}
5292 set searchdirn -forwards
5299 set selectedhlview None
5312 if {$cmdline_files ne {} || $revtreeargs ne {}} {
5313 # create a view for the files/dirs specified on the command line
5317 set viewname(1) "Command line"
5318 set viewfiles(1) $cmdline_files
5319 set viewargs(1) $revtreeargs
5322 .bar.view entryconf 2 -state normal
5323 .bar.view entryconf 3 -state normal
5326 if {[info exists permviews]} {
5327 foreach v $permviews {
5330 set viewname($n) [lindex $v 0]
5331 set viewfiles($n) [lindex $v 1]
5332 set viewargs($n) [lindex $v 2]