proc start_rev_list {view} {
global startmsecs
global commfd leftover tclencoding datemode
- global viewargs viewfiles commitidx vnextroot
- global lookingforhead showlocalchanges
+ global viewargs viewfiles commitidx viewcomplete vnextroot
+ global showlocalchanges commitinterest mainheadid
+ global progressdirn progresscoords proglastnc curview
set startmsecs [clock clicks -milliseconds]
set commitidx($view) 0
+ set viewcomplete($view) 0
set vnextroot($view) 0
set order "--topo-order"
if {$datemode} {
set order "--date-order"
}
if {[catch {
- set fd [open [concat | git log -z --pretty=raw $order --parents \
+ set fd [open [concat | git log --no-color -z --pretty=raw $order --parents \
--boundary $viewargs($view) "--" $viewfiles($view)] r]
} err]} {
- error_popup "Error executing git rev-list: $err"
+ error_popup "[mc "Error executing git rev-list:"] $err"
exit 1
}
set commfd($view) $fd
set leftover($view) {}
- set lookingforhead $showlocalchanges
+ if {$showlocalchanges} {
+ lappend commitinterest($mainheadid) {dodiffindex}
+ }
fconfigure $fd -blocking 0 -translation lf -eofchar {}
if {$tclencoding != {}} {
fconfigure $fd -encoding $tclencoding
}
filerun $fd [list getcommitlines $fd $view]
- nowbusy $view
+ nowbusy $view [mc "Reading"]
+ if {$view == $curview} {
+ set progressdirn 1
+ set progresscoords {0 0}
+ set proglastnc 0
+ }
}
proc stop_rev_list {} {
}
proc getcommits {} {
- global phase canv mainfont curview
+ global phase canv curview
set phase getcommits
initlayout
start_rev_list $curview
- show_status "Reading commits..."
+ show_status [mc "Reading commits..."]
}
# This makes a string representation of a positive integer which
}
proc getcommitlines {fd view} {
- global commitlisted
+ global commitlisted commitinterest
global leftover commfd
- global displayorder commitidx commitrow commitdata
+ global displayorder commitidx viewcomplete commitrow commitdata
global parentlist children curview hlview
global vparentlist vdisporder vcmitlisted
- global ordertok vnextroot
+ global ordertok vnextroot idpending
set stuff [read $fd 500000]
# git log doesn't terminate the last commit with a null...
if {![eof $fd]} {
return 1
}
- global viewname
+ # Check if we have seen any ids listed as parents that haven't
+ # appeared in the list
+ foreach vid [array names idpending "$view,*"] {
+ # should only get here if git log is buggy
+ set id [lindex [split $vid ","] 1]
+ set commitrow($vid) $commitidx($view)
+ incr commitidx($view)
+ if {$view == $curview} {
+ lappend parentlist {}
+ lappend displayorder $id
+ lappend commitlisted 0
+ } else {
+ lappend vparentlist($view) {}
+ lappend vdisporder($view) $id
+ lappend vcmitlisted($view) 0
+ }
+ }
+ set viewcomplete($view) 1
+ global viewname progresscoords
unset commfd($view)
notbusy $view
+ set progresscoords {0 0}
+ adjustprogress
# set it blocking so we wait for the process to terminate
fconfigure $fd -blocking 1
if {[catch {close $fd} err]} {
if {[string length $shortcmit] > 80} {
set shortcmit "[string range $shortcmit 0 80]..."
}
- error_popup "Can't parse git log output: {$shortcmit}"
+ error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
exit 1
}
set id [lindex $ids 0]
set ordertok($view,$id) $otok
} else {
set otok $ordertok($view,$id)
+ unset idpending($view,$id)
}
if {$listed} {
set olds [lrange $ids 1 end]
lappend children($view,$p) $id
if {![info exists ordertok($view,$p)]} {
set ordertok($view,$p) $ordertok($view,$id)
+ set idpending($view,$p) 1
}
} else {
set i 0
}
if {![info exists ordertok($view,$p)]} {
set ordertok($view,$p) "$otok[strrep $i]]"
+ set idpending($view,$p) 1
}
incr i
}
lappend vdisporder($view) $id
lappend vcmitlisted($view) $listed
}
+ if {[info exists commitinterest($id)]} {
+ foreach script $commitinterest($id) {
+ eval [string map [list "%I" $id] $script]
+ }
+ unset commitinterest($id)
+ }
set gotsome 1
}
if {$gotsome} {
run chewcommits $view
+ if {$view == $curview} {
+ # update progress bar
+ global progressdirn progresscoords proglastnc
+ set inc [expr {($commitidx($view) - $proglastnc) * 0.0002}]
+ set proglastnc $commitidx($view)
+ set l [lindex $progresscoords 0]
+ set r [lindex $progresscoords 1]
+ if {$progressdirn} {
+ set r [expr {$r + $inc}]
+ if {$r >= 1.0} {
+ set r 1.0
+ set progressdirn 0
+ }
+ if {$r > 0.2} {
+ set l [expr {$r - 0.2}]
+ }
+ } else {
+ set l [expr {$l - $inc}]
+ if {$l <= 0.0} {
+ set l 0.0
+ set progressdirn 1
+ }
+ set r [expr {$l + 0.2}]
+ }
+ set progresscoords [list $l $r]
+ adjustprogress
+ }
}
return 2
}
proc chewcommits {view} {
- global curview hlview commfd
+ global curview hlview viewcomplete
global selectedline pending_select
- set more 0
if {$view == $curview} {
- set allread [expr {![info exists commfd($view)]}]
- set tlimit [expr {[clock clicks -milliseconds] + 50}]
- set more [layoutmore $tlimit $allread]
- if {$allread && !$more} {
+ layoutmore
+ if {$viewcomplete($view)} {
global displayorder commitidx phase
global numcommits startmsecs
#set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
#puts "overall $ms ms for $numcommits commits"
} else {
- show_status "No commits selected"
+ show_status [mc "No commits selected"]
}
notbusy layout
set phase {}
if {[info exists hlview] && $view == $hlview} {
vhighlightmore
}
- return $more
+ return 0
}
proc readcommit {id} {
}
proc updatecommits {} {
- global viewdata curview phase displayorder
- global children commitrow selectedline thickerline
+ global viewdata curview phase displayorder ordertok idpending
+ global children commitrow selectedline thickerline showneartags
if {$phase ne {}} {
stop_rev_list
foreach id $displayorder {
catch {unset children($n,$id)}
catch {unset commitrow($n,$id)}
+ catch {unset ordertok($n,$id)}
+ }
+ foreach vid [array names idpending "$n,*"] {
+ unset idpending($vid)
}
set curview -1
catch {unset selectedline}
catch {unset viewdata($n)}
readrefs
changedrefs
- regetallcommits
+ if {$showneartags} {
+ getallcommits
+ }
showview $n
}
} else {
readcommit $id
if {![info exists commitinfo($id)]} {
- set commitinfo($id) {"No commit information available"}
+ set commitinfo($id) [list [mc "No commit information available"]]
}
}
return 1
lappend idotherrefs($id) $name
}
}
- close $refd
+ catch {close $refd}
set mainhead {}
set mainheadid {}
catch {
proc show_error {w top msg} {
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
- button $w.ok -text OK -command "destroy $top"
+ button $w.ok -text [mc OK] -command "destroy $top"
pack $w.ok -side bottom -fill x
bind $top <Visibility> "grab $top; focus $top"
bind $top <Key-Return> "destroy $top"
wm transient $w .
message $w.m -text $msg -justify center -aspect 400
pack $w.m -side top -fill x -padx 20 -pady 20
- button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
+ button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
pack $w.ok -side left -fill x
- button $w.cancel -text Cancel -command "destroy $w"
+ button $w.cancel -text [mc Cancel] -command "destroy $w"
pack $w.cancel -side right -fill x
bind $w <Visibility> "grab $w; focus $w"
tkwait window $w
proc makewindow {} {
global canv canv2 canv3 linespc charspc ctext cflist
- global textfont mainfont uifont tabstop
+ global tabstop
global findtype findtypemenu findloc findstring fstring geometry
global entries sha1entry sha1string sha1but
+ global diffcontextstring diffcontext
global maincursor textcursor curtextcursor
global rowctxmenu fakerowmenu mergemax wrapcomment
global highlight_files gdttype
global searchstring sstring
global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
- global headctxmenu
+ global headctxmenu progresscanv progressitem progresscoords statusw
+ global fprogitem fprogcoord lastprogupdate progupdatepending
+ global rprogitem rprogcoord
+ global have_tk85
menu .bar
- .bar add cascade -label "File" -menu .bar.file
- .bar configure -font $uifont
+ .bar add cascade -label [mc "File"] -menu .bar.file
+ .bar configure -font uifont
menu .bar.file
- .bar.file add command -label "Update" -command updatecommits
- .bar.file add command -label "Reread references" -command rereadrefs
- .bar.file add command -label "Quit" -command doquit
- .bar.file configure -font $uifont
+ .bar.file add command -label [mc "Update"] -command updatecommits
+ .bar.file add command -label [mc "Reread references"] -command rereadrefs
+ .bar.file add command -label [mc "List references"] -command showrefs
+ .bar.file add command -label [mc "Quit"] -command doquit
+ .bar.file configure -font uifont
menu .bar.edit
- .bar add cascade -label "Edit" -menu .bar.edit
- .bar.edit add command -label "Preferences" -command doprefs
- .bar.edit configure -font $uifont
-
- menu .bar.view -font $uifont
- .bar add cascade -label "View" -menu .bar.view
- .bar.view add command -label "New view..." -command {newview 0}
- .bar.view add command -label "Edit view..." -command editview \
+ .bar add cascade -label [mc "Edit"] -menu .bar.edit
+ .bar.edit add command -label [mc "Preferences"] -command doprefs
+ .bar.edit configure -font uifont
+
+ menu .bar.view -font uifont
+ .bar add cascade -label [mc "View"] -menu .bar.view
+ .bar.view add command -label [mc "New view..."] -command {newview 0}
+ .bar.view add command -label [mc "Edit view..."] -command editview \
-state disabled
- .bar.view add command -label "Delete view" -command delview -state disabled
+ .bar.view add command -label [mc "Delete view"] -command delview -state disabled
.bar.view add separator
- .bar.view add radiobutton -label "All files" -command {showview 0} \
+ .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \
-variable selectedview -value 0
menu .bar.help
- .bar add cascade -label "Help" -menu .bar.help
- .bar.help add command -label "About gitk" -command about
- .bar.help add command -label "Key bindings" -command keys
- .bar.help configure -font $uifont
+ .bar add cascade -label [mc "Help"] -menu .bar.help
+ .bar.help add command -label [mc "About gitk"] -command about
+ .bar.help add command -label [mc "Key bindings"] -command keys
+ .bar.help configure -font uifont
. configure -menu .bar
# the gui has upper and lower half, parts of a paned window.
set sha1entry .tf.bar.sha1
set entries $sha1entry
set sha1but .tf.bar.sha1label
- button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
- -command gotocommit -width 8 -font $uifont
+ button $sha1but -text [mc "SHA1 ID: "] -state disabled -relief flat \
+ -command gotocommit -width 8 -font uifont
$sha1but conf -disabledforeground [$sha1but cget -foreground]
pack .tf.bar.sha1label -side left
- entry $sha1entry -width 40 -font $textfont -textvariable sha1string
+ entry $sha1entry -width 40 -font textfont -textvariable sha1string
trace add variable sha1string write sha1change
pack $sha1entry -side left -pady 2
-state disabled -width 26
pack .tf.bar.rightbut -side left -fill y
- button .tf.bar.findbut -text "Find" -command dofind -font $uifont
- pack .tf.bar.findbut -side left
+ # Status label and progress bar
+ set statusw .tf.bar.status
+ label $statusw -width 15 -relief sunken -font uifont
+ pack $statusw -side left -padx 5
+ set h [expr {[font metrics uifont -linespace] + 2}]
+ set progresscanv .tf.bar.progress
+ canvas $progresscanv -relief sunken -height $h -borderwidth 2
+ set progressitem [$progresscanv create rect -1 0 0 $h -fill green]
+ set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow]
+ set rprogitem [$progresscanv create rect -1 0 0 $h -fill red]
+ pack $progresscanv -side right -expand 1 -fill x
+ set progresscoords {0 0}
+ set fprogcoord 0
+ set rprogcoord 0
+ bind $progresscanv <Configure> adjustprogress
+ set lastprogupdate [clock clicks -milliseconds]
+ set progupdatepending 0
+
+ # build up the bottom bar of upper window
+ label .tf.lbar.flabel -text "[mc "Find"] " -font uifont
+ button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1} -font uifont
+ button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1} -font uifont
+ label .tf.lbar.flab2 -text " [mc "commit"] " -font uifont
+ pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
+ -side left -fill y
+ set gdttype "containing:"
+ set gm [tk_optionMenu .tf.lbar.gdttype gdttype \
+ "containing:" \
+ "touching paths:" \
+ "adding/removing string:"]
+ trace add variable gdttype write gdttype_change
+ $gm conf -font uifont
+ .tf.lbar.gdttype conf -font uifont
+ pack .tf.lbar.gdttype -side left -fill y
+
set findstring {}
- set fstring .tf.bar.findstring
+ set fstring .tf.lbar.findstring
lappend entries $fstring
- entry $fstring -width 30 -font $textfont -textvariable findstring
+ entry $fstring -width 30 -font textfont -textvariable findstring
trace add variable findstring write find_change
- pack $fstring -side left -expand 1 -fill x -in .tf.bar
set findtype Exact
- set findtypemenu [tk_optionMenu .tf.bar.findtype \
+ set findtypemenu [tk_optionMenu .tf.lbar.findtype \
findtype Exact IgnCase Regexp]
- trace add variable findtype write find_change
- .tf.bar.findtype configure -font $uifont
- .tf.bar.findtype.menu configure -font $uifont
+ trace add variable findtype write findcom_change
+ .tf.lbar.findtype configure -font uifont
+ .tf.lbar.findtype.menu configure -font uifont
set findloc "All fields"
- tk_optionMenu .tf.bar.findloc findloc "All fields" Headline \
+ tk_optionMenu .tf.lbar.findloc findloc "All fields" Headline \
Comments Author Committer
trace add variable findloc write find_change
- .tf.bar.findloc configure -font $uifont
- .tf.bar.findloc.menu configure -font $uifont
- pack .tf.bar.findloc -side right
- pack .tf.bar.findtype -side right
-
- # build up the bottom bar of upper window
- label .tf.lbar.flabel -text "Highlight: Commits " \
- -font $uifont
- pack .tf.lbar.flabel -side left -fill y
- set gdttype "touching paths:"
- set gm [tk_optionMenu .tf.lbar.gdttype gdttype "touching paths:" \
- "adding/removing string:"]
- trace add variable gdttype write hfiles_change
- $gm conf -font $uifont
- .tf.lbar.gdttype conf -font $uifont
- pack .tf.lbar.gdttype -side left -fill y
- entry .tf.lbar.fent -width 25 -font $textfont \
- -textvariable highlight_files
- trace add variable highlight_files write hfiles_change
- lappend entries .tf.lbar.fent
- pack .tf.lbar.fent -side left -fill x -expand 1
- label .tf.lbar.vlabel -text " OR in view" -font $uifont
- pack .tf.lbar.vlabel -side left -fill y
- global viewhlmenu selectedhlview
- set viewhlmenu [tk_optionMenu .tf.lbar.vhl selectedhlview None]
- $viewhlmenu entryconf None -command delvhighlight
- $viewhlmenu conf -font $uifont
- .tf.lbar.vhl conf -font $uifont
- pack .tf.lbar.vhl -side left -fill y
- label .tf.lbar.rlabel -text " OR " -font $uifont
- pack .tf.lbar.rlabel -side left -fill y
- global highlight_related
- set m [tk_optionMenu .tf.lbar.relm highlight_related None \
- "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
- $m conf -font $uifont
- .tf.lbar.relm conf -font $uifont
- trace add variable highlight_related write vrel_change
- pack .tf.lbar.relm -side left -fill y
+ .tf.lbar.findloc configure -font uifont
+ .tf.lbar.findloc.menu configure -font uifont
+ pack .tf.lbar.findloc -side right
+ pack .tf.lbar.findtype -side right
+ pack $fstring -side left -expand 1 -fill x
# Finish putting the upper half of the viewer together
pack .tf.lbar -in .tf -side bottom -fill x
frame .bleft.top
frame .bleft.mid
- button .bleft.top.search -text "Search" -command dosearch \
- -font $uifont
+ button .bleft.top.search -text [mc "Search"] -command dosearch \
+ -font uifont
pack .bleft.top.search -side left -padx 5
set sstring .bleft.top.sstring
- entry $sstring -width 20 -font $textfont -textvariable searchstring
+ entry $sstring -width 20 -font textfont -textvariable searchstring
lappend entries $sstring
trace add variable searchstring write incrsearch
pack $sstring -side left -expand 1 -fill x
- radiobutton .bleft.mid.diff -text "Diff" \
+ radiobutton .bleft.mid.diff -text [mc "Diff"] -font uifont \
-command changediffdisp -variable diffelide -value {0 0}
- radiobutton .bleft.mid.old -text "Old version" \
+ radiobutton .bleft.mid.old -text [mc "Old version"] -font uifont \
-command changediffdisp -variable diffelide -value {0 1}
- radiobutton .bleft.mid.new -text "New version" \
+ radiobutton .bleft.mid.new -text [mc "New version"] -font uifont \
-command changediffdisp -variable diffelide -value {1 0}
+ label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: " \
+ -font uifont
pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left
+ spinbox .bleft.mid.diffcontext -width 5 -font textfont \
+ -from 1 -increment 1 -to 10000000 \
+ -validate all -validatecommand "diffcontextvalidate %P" \
+ -textvariable diffcontextstring
+ .bleft.mid.diffcontext set $diffcontext
+ trace add variable diffcontextstring write diffcontextchange
+ lappend entries .bleft.mid.diffcontext
+ pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left
set ctext .bleft.ctext
text $ctext -background $bgcolor -foreground $fgcolor \
- -tabs "[expr {$tabstop * $charspc}]" \
- -state disabled -font $textfont \
+ -state disabled -font textfont \
-yscrollcommand scrolltext -wrap none
+ if {$have_tk85} {
+ $ctext conf -tabstyle wordprocessor
+ }
scrollbar .bleft.sb -command "$ctext yview"
pack .bleft.top -side top -fill x
pack .bleft.mid -side top -fill x
lappend fglist $ctext
$ctext tag conf comment -wrap $wrapcomment
- $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
+ $ctext tag conf filesep -font textfontbold -back "#aaaaaa"
$ctext tag conf hunksep -fore [lindex $diffcolors 2]
$ctext tag conf d0 -fore [lindex $diffcolors 0]
$ctext tag conf d1 -fore [lindex $diffcolors 1]
$ctext tag conf m15 -fore "#ff70b0"
$ctext tag conf mmax -fore darkgrey
set mergemax 16
- $ctext tag conf mresult -font [concat $textfont bold]
- $ctext tag conf msep -font [concat $textfont bold]
+ $ctext tag conf mresult -font textfontbold
+ $ctext tag conf msep -font textfontbold
$ctext tag conf found -back yellow
.pwbottom add .bleft
# lower right
frame .bright
frame .bright.mode
- radiobutton .bright.mode.patch -text "Patch" \
+ radiobutton .bright.mode.patch -text [mc "Patch"] \
-command reselectline -variable cmitmode -value "patch"
- .bright.mode.patch configure -font $uifont
- radiobutton .bright.mode.tree -text "Tree" \
+ .bright.mode.patch configure -font uifont
+ radiobutton .bright.mode.tree -text [mc "Tree"] \
-command reselectline -variable cmitmode -value "tree"
- .bright.mode.tree configure -font $uifont
+ .bright.mode.tree configure -font uifont
grid .bright.mode.patch .bright.mode.tree -sticky ew
pack .bright.mode -side top -fill x
set cflist .bright.cfiles
- set indent [font measure $mainfont "nn"]
+ set indent [font measure mainfont "nn"]
text $cflist \
-selectbackground $selectbgcolor \
-background $bgcolor -foreground $fgcolor \
- -font $mainfont \
+ -font mainfont \
-tabs [list $indent [expr {2 * $indent}]] \
-yscrollcommand ".bright.sb set" \
-cursor [. cget -cursor] \
pack $cflist -side left -fill both -expand 1
$cflist tag configure highlight \
-background [$cflist cget -selectbackground]
- $cflist tag configure bold -font [concat $mainfont bold]
+ $cflist tag configure bold -font mainfontbold
.pwbottom add .bright
.ctop add .pwbottom
pack .ctop -fill both -expand 1
bindall <1> {selcanvline %W %x %y}
#bindall <B1-Motion> {selcanvline %W %x %y}
- bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
- bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+ if {[tk windowingsystem] == "win32"} {
+ bind . <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D }
+ bind $ctext <MouseWheel> { windows_mousewheel_redirector %W %X %Y %D ; break }
+ } else {
+ bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
+ bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
+ if {[tk windowingsystem] eq "aqua"} {
+ bindall <MouseWheel> {
+ set delta [expr {- (%D)}]
+ allcanvs yview scroll $delta units
+ }
+ }
+ }
bindall <2> "canvscan mark %W %x %y"
bindall <B2-Motion> "canvscan dragto %W %x %y"
bindkey <Home> selfirstline
bindkey <End> sellastline
bind . <Key-Up> "selnextline -1"
bind . <Key-Down> "selnextline 1"
- bind . <Shift-Key-Up> "next_highlight -1"
- bind . <Shift-Key-Down> "next_highlight 1"
+ bind . <Shift-Key-Up> "dofind -1 0"
+ bind . <Shift-Key-Down> "dofind 1 0"
bindkey <Key-Right> "goforw"
bindkey <Key-Left> "goback"
bind . <Key-Prior> "selnextpage -1"
bindkey b "$ctext yview scroll -1 pages"
bindkey d "$ctext yview scroll 18 units"
bindkey u "$ctext yview scroll -18 units"
- bindkey / {findnext 1}
- bindkey <Key-Return> {findnext 0}
- bindkey ? findprev
+ bindkey / {dofind 1 1}
+ bindkey <Key-Return> {dofind 1 1}
+ bindkey ? {dofind -1 1}
bindkey f nextfile
bindkey <F5> updatecommits
bind . <$M1B-q> doquit
- bind . <$M1B-f> dofind
- bind . <$M1B-g> {findnext 0}
+ bind . <$M1B-f> {dofind 1 1}
+ bind . <$M1B-g> {dofind 1 0}
bind . <$M1B-r> dosearchback
bind . <$M1B-s> dosearch
bind . <$M1B-equal> {incrfont 1}
bind . <$M1B-KP_Subtract> {incrfont -1}
wm protocol . WM_DELETE_WINDOW doquit
bind . <Button-1> "click %W"
- bind $fstring <Key-Return> dofind
+ bind $fstring <Key-Return> {dofind 1 1}
bind $sha1entry <Key-Return> gotocommit
bind $sha1entry <<PasteSelection>> clearsha1
bind $cflist <1> {sel_flist %W %x %y; break}
set rowctxmenu .rowctxmenu
menu $rowctxmenu -tearoff 0
- $rowctxmenu add command -label "Diff this -> selected" \
+ $rowctxmenu add command -label [mc "Diff this -> selected"] \
-command {diffvssel 0}
- $rowctxmenu add command -label "Diff selected -> this" \
+ $rowctxmenu add command -label [mc "Diff selected -> this"] \
-command {diffvssel 1}
- $rowctxmenu add command -label "Make patch" -command mkpatch
- $rowctxmenu add command -label "Create tag" -command mktag
- $rowctxmenu add command -label "Write commit to file" -command writecommit
- $rowctxmenu add command -label "Create new branch" -command mkbranch
- $rowctxmenu add command -label "Cherry-pick this commit" \
+ $rowctxmenu add command -label [mc "Make patch"] -command mkpatch
+ $rowctxmenu add command -label [mc "Create tag"] -command mktag
+ $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit
+ $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch
+ $rowctxmenu add command -label [mc "Cherry-pick this commit"] \
-command cherrypick
- $rowctxmenu add command -label "Reset HEAD branch to here" \
+ $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \
-command resethead
set fakerowmenu .fakerowmenu
menu $fakerowmenu -tearoff 0
- $fakerowmenu add command -label "Diff this -> selected" \
+ $fakerowmenu add command -label [mc "Diff this -> selected"] \
-command {diffvssel 0}
- $fakerowmenu add command -label "Diff selected -> this" \
+ $fakerowmenu add command -label [mc "Diff selected -> this"] \
-command {diffvssel 1}
- $fakerowmenu add command -label "Make patch" -command mkpatch
-# $fakerowmenu add command -label "Commit" -command {mkcommit 0}
-# $fakerowmenu add command -label "Commit all" -command {mkcommit 1}
-# $fakerowmenu add command -label "Revert local changes" -command revertlocal
+ $fakerowmenu add command -label [mc "Make patch"] -command mkpatch
+# $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0}
+# $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1}
+# $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal
set headctxmenu .headctxmenu
menu $headctxmenu -tearoff 0
- $headctxmenu add command -label "Check out this branch" \
+ $headctxmenu add command -label [mc "Check out this branch"] \
-command cobranch
- $headctxmenu add command -label "Remove this branch" \
+ $headctxmenu add command -label [mc "Remove this branch"] \
-command rmbranch
global flist_menu
set flist_menu .flistctxmenu
menu $flist_menu -tearoff 0
- $flist_menu add command -label "Highlight this too" \
+ $flist_menu add command -label [mc "Highlight this too"] \
-command {flist_hl 0}
- $flist_menu add command -label "Highlight this only" \
+ $flist_menu add command -label [mc "Highlight this only"] \
-command {flist_hl 1}
}
+# Windows sends all mouse wheel events to the current focused window, not
+# the one where the mouse hovers, so bind those events here and redirect
+# to the correct window
+proc windows_mousewheel_redirector {W X Y D} {
+ global canv canv2 canv3
+ set w [winfo containing -displayof $W $X $Y]
+ if {$w ne ""} {
+ set u [expr {$D < 0 ? 5 : -5}]
+ if {$w == $canv || $w == $canv2 || $w == $canv3} {
+ allcanvs yview scroll $u units
+ } else {
+ catch {
+ $w yview scroll $u units
+ }
+ }
+ }
+}
+
# mouse-2 makes all windows scan vertically, but only the one
# the cursor is in scans horizontally
proc canvscan {op w x y} {
# set the focus back to the toplevel for any click outside
# the entry widgets
proc click {w} {
- global entries
- foreach e $entries {
+ global ctext entries
+ foreach e [concat $entries $ctext] {
if {$w == $e} return
}
focus .
}
+# Adjust the progress bar for a change in requested extent or canvas size
+proc adjustprogress {} {
+ global progresscanv progressitem progresscoords
+ global fprogitem fprogcoord lastprogupdate progupdatepending
+ global rprogitem rprogcoord
+
+ set w [expr {[winfo width $progresscanv] - 4}]
+ set x0 [expr {$w * [lindex $progresscoords 0]}]
+ set x1 [expr {$w * [lindex $progresscoords 1]}]
+ set h [winfo height $progresscanv]
+ $progresscanv coords $progressitem $x0 0 $x1 $h
+ $progresscanv coords $fprogitem 0 0 [expr {$w * $fprogcoord}] $h
+ $progresscanv coords $rprogitem 0 0 [expr {$w * $rprogcoord}] $h
+ set now [clock clicks -milliseconds]
+ if {$now >= $lastprogupdate + 100} {
+ set progupdatepending 0
+ update
+ } elseif {!$progupdatepending} {
+ set progupdatepending 1
+ after [expr {$lastprogupdate + 100 - $now}] doprogupdate
+ }
+}
+
+proc doprogupdate {} {
+ global lastprogupdate progupdatepending
+
+ if {$progupdatepending} {
+ set progupdatepending 0
+ set lastprogupdate [clock clicks -milliseconds]
+ update
+ }
+}
+
proc savestuff {w} {
- global canv canv2 canv3 ctext cflist mainfont textfont uifont tabstop
+ global canv canv2 canv3 mainfont textfont uifont tabstop
global stuffsaved findmergefiles maxgraphpct
global maxwidth showneartags showlocalchanges
global viewname viewfiles viewargs viewperm nextviewnum
- global cmitmode wrapcomment
- global colors bgcolor fgcolor diffcolors selectbgcolor
+ global cmitmode wrapcomment datetimeformat limitdiffs
+ global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor
if {$stuffsaved} return
if {![winfo viewable .]} return
puts $f [list set wrapcomment $wrapcomment]
puts $f [list set showneartags $showneartags]
puts $f [list set showlocalchanges $showlocalchanges]
+ puts $f [list set datetimeformat $datetimeformat]
+ puts $f [list set limitdiffs $limitdiffs]
puts $f [list set bgcolor $bgcolor]
puts $f [list set fgcolor $fgcolor]
puts $f [list set colors $colors]
puts $f [list set diffcolors $diffcolors]
+ puts $f [list set diffcontext $diffcontext]
puts $f [list set selectbgcolor $selectbgcolor]
puts $f "set geometry(main) [wm geometry .]"
return
}
toplevel $w
- wm title $w "About gitk"
- message $w.m -text {
+ wm title $w [mc "About gitk"]
+ message $w.m -text [mc "
Gitk - a commit viewer for git
Copyright © 2005-2006 Paul Mackerras
-Use and redistribute under the terms of the GNU General Public License} \
+Use and redistribute under the terms of the GNU General Public License"] \
-justify center -aspect 400 -border 2 -bg white -relief groove
pack $w.m -side top -fill x -padx 2 -pady 2
- $w.m configure -font $uifont
- button $w.ok -text Close -command "destroy $w" -default active
+ $w.m configure -font uifont
+ button $w.ok -text [mc "Close"] -command "destroy $w" -default active
pack $w.ok -side bottom
- $w.ok configure -font $uifont
+ $w.ok configure -font uifont
bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w"
bind $w <Key-Return> "destroy $w"
set M1T Ctrl
}
toplevel $w
- wm title $w "Gitk key bindings"
- message $w.m -text "
+ wm title $w [mc "Gitk key bindings"]
+ message $w.m -text [mc "
Gitk key bindings:
<$M1T-Q> Quit
<$M1T-Down> Scroll commit list down one line
<$M1T-PageUp> Scroll commit list up one page
<$M1T-PageDown> Scroll commit list down one page
-<Shift-Up> Move to previous highlighted line
-<Shift-Down> Move to next highlighted line
+<Shift-Up> Find backwards (upwards, later commits)
+<Shift-Down> Find forwards (downwards, earlier commits)
<Delete>, b Scroll diff view up one page
<Backspace> Scroll diff view up one page
<Space> Scroll diff view down one page
<$M1T-KP-> Decrease font size
<$M1T-minus> Decrease font size
<F5> Update
-" \
+"] \
-justify left -bg white -border 2 -relief groove
pack $w.m -side top -fill both -padx 2 -pady 2
- $w.m configure -font $uifont
- button $w.ok -text Close -command "destroy $w" -default active
+ $w.m configure -font uifont
+ button $w.ok -text [mc "Close"] -command "destroy $w" -default active
pack $w.ok -side bottom
- $w.ok configure -font $uifont
+ $w.ok configure -font uifont
bind $w <Visibility> "focus $w.ok"
bind $w <Key-Escape> "destroy $w"
bind $w <Key-Return> "destroy $w"
0x00, 0x00};
}
+image create bitmap reficon-T -background black -foreground yellow -data {
+ #define tagicon_width 13
+ #define tagicon_height 9
+ static unsigned char tagicon_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xf0, 0x07, 0xf8, 0x07,
+ 0xfc, 0x07, 0xf8, 0x07, 0xf0, 0x07, 0x00, 0x00, 0x00, 0x00};
+} -maskdata {
+ #define tagicon-mask_width 13
+ #define tagicon-mask_height 9
+ static unsigned char tagicon-mask_bits[] = {
+ 0x00, 0x00, 0xf0, 0x0f, 0xf8, 0x0f, 0xfc, 0x0f,
+ 0xfe, 0x0f, 0xfc, 0x0f, 0xf8, 0x0f, 0xf0, 0x0f, 0x00, 0x00};
+}
+set rectdata {
+ #define headicon_width 13
+ #define headicon_height 9
+ static unsigned char headicon_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xf8, 0x07, 0xf8, 0x07,
+ 0xf8, 0x07, 0xf8, 0x07, 0xf8, 0x07, 0x00, 0x00, 0x00, 0x00};
+}
+set rectmask {
+ #define headicon-mask_width 13
+ #define headicon-mask_height 9
+ static unsigned char headicon-mask_bits[] = {
+ 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f,
+ 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00};
+}
+image create bitmap reficon-H -background black -foreground green \
+ -data $rectdata -maskdata $rectmask
+image create bitmap reficon-o -background black -foreground "#ddddff" \
+ -data $rectdata -maskdata $rectmask
+
proc init_flist {first} {
global cflist cflist_top selectedline difffilestart
global ctext cflist cmitmode flist_menu flist_menu_file
global treediffs diffids
+ stopfinding
set l [lindex [split [$w index "@$x,$y"] "."] 0]
if {$l <= 1} return
if {$cmitmode eq "tree"} {
}
proc flist_hl {only} {
- global flist_menu_file highlight_files
+ global flist_menu_file findstring gdttype
set x [shellquote $flist_menu_file]
- if {$only || $highlight_files eq {}} {
- set highlight_files $x
+ if {$only || $findstring eq {} || $gdttype ne "touching paths:"} {
+ set findstring $x
} else {
- append highlight_files " " $x
+ append findstring " " $x
}
+ set gdttype "touching paths:"
}
# Functions for adding and removing shell-type quoting
set newviewname($nextviewnum) "View $nextviewnum"
set newviewperm($nextviewnum) 0
set newviewargs($nextviewnum) [shellarglist $revtreeargs]
- vieweditor $top $nextviewnum "Gitk view definition"
+ vieweditor $top $nextviewnum [mc "Gitk view definition"]
}
proc editview {} {
toplevel $top
wm title $top $title
- label $top.nl -text "Name" -font $uifont
- entry $top.name -width 20 -textvariable newviewname($n) -font $uifont
+ label $top.nl -text [mc "Name"] -font uifont
+ entry $top.name -width 20 -textvariable newviewname($n) -font uifont
grid $top.nl $top.name -sticky w -pady 5
- checkbutton $top.perm -text "Remember this view" -variable newviewperm($n) \
- -font $uifont
+ checkbutton $top.perm -text [mc "Remember this view"] -variable newviewperm($n) \
+ -font uifont
grid $top.perm - -pady 5 -sticky w
- message $top.al -aspect 1000 -font $uifont \
- -text "Commits to include (arguments to git rev-list):"
+ message $top.al -aspect 1000 -font uifont \
+ -text [mc "Commits to include (arguments to git rev-list):"]
grid $top.al - -sticky w -pady 5
entry $top.args -width 50 -textvariable newviewargs($n) \
- -background white -font $uifont
+ -background white -font uifont
grid $top.args - -sticky ew -padx 5
- message $top.l -aspect 1000 -font $uifont \
- -text "Enter files and directories to include, one per line:"
+ message $top.l -aspect 1000 -font uifont \
+ -text [mc "Enter files and directories to include, one per line:"]
grid $top.l - -sticky w
- text $top.t -width 40 -height 10 -background white -font $uifont
+ text $top.t -width 40 -height 10 -background white -font uifont
if {[info exists viewfiles($n)]} {
foreach f $viewfiles($n) {
$top.t insert end $f
}
grid $top.t - -sticky ew -padx 5
frame $top.buts
- button $top.buts.ok -text "OK" -command [list newviewok $top $n] \
- -font $uifont
- button $top.buts.can -text "Cancel" -command [list destroy $top] \
- -font $uifont
+ button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n] \
+ -font uifont
+ button $top.buts.can -text [mc "Cancel"] -command [list destroy $top] \
+ -font uifont
grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
}
proc allviewmenus {n op args} {
- global viewhlmenu
+ # global viewhlmenu
doviewmenu .bar.view 5 [list showview $n] $op $args
- doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
+ # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
}
proc newviewok {top n} {
if {[catch {
set newargs [shellsplit $newviewargs($n)]
} err]} {
- error_popup "Error in commit selection arguments: $err"
+ error_popup "[mc "Error in commit selection arguments:"] $err"
wm raise $top
focus $top
return
set viewname($n) $newviewname($n)
doviewmenu .bar.view 5 [list showview $n] \
entryconf [list -label $viewname($n)]
- doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
- entryconf [list -label $viewname($n) -value $viewname($n)]
+ # doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
+ # entryconf [list -label $viewname($n) -value $viewname($n)]
}
if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
set viewfiles($n) $files
.bar.view add radiobutton -label $viewname($n) \
-command [list showview $n] -variable selectedview -value $n
- $viewhlmenu add radiobutton -label $viewname($n) \
- -command [list addvhighlight $n] -variable selectedhlview
+ #$viewhlmenu add radiobutton -label $viewname($n) \
+ # -command [list addvhighlight $n] -variable selectedhlview
}
proc flatten {var} {
proc showview {n} {
global curview viewdata viewfiles
- global displayorder parentlist rowidlist
+ global displayorder parentlist rowidlist rowisopt rowfinal
global colormap rowtextx commitrow nextcolor canvxmax
- global numcommits rowrangelist commitlisted idrowranges rowchk
+ global numcommits commitlisted
global selectedline currentid canv canvy0
global treediffs
global pending_select phase
- global commitidx rowlaidout rowoptim
+ global commitidx
global commfd
global selectedview selectfirst
global vparentlist vdisporder vcmitlisted
- global hlview selectedhlview
+ global hlview selectedhlview commitinterest
if {$n == $curview} return
set selid {}
set vparentlist($curview) $parentlist
set vdisporder($curview) $displayorder
set vcmitlisted($curview) $commitlisted
- if {$phase ne {}} {
+ if {$phase ne {} ||
+ ![info exists viewdata($curview)] ||
+ [lindex $viewdata($curview) 0] ne {}} {
set viewdata($curview) \
- [list $phase $rowidlist {} $rowrangelist \
- [flatten idrowranges] [flatten idinlist] \
- $rowlaidout $rowoptim $numcommits]
- } elseif {![info exists viewdata($curview)]
- || [lindex $viewdata($curview) 0] ne {}} {
- set viewdata($curview) \
- [list {} $rowidlist {} $rowrangelist]
+ [list $phase $rowidlist $rowisopt $rowfinal]
}
}
catch {unset treediffs}
unset hlview
set selectedhlview None
}
+ catch {unset commitinterest}
set curview $n
set selectedview $n
- .bar.view entryconf Edit* -state [expr {$n == 0? "disabled": "normal"}]
- .bar.view entryconf Delete* -state [expr {$n == 0? "disabled": "normal"}]
+ .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}]
+ .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}]
+ run refill_reflist
if {![info exists viewdata($n)]} {
if {$selid ne {}} {
set pending_select $selid
set parentlist $vparentlist($n)
set commitlisted $vcmitlisted($n)
set rowidlist [lindex $v 1]
- set rowrangelist [lindex $v 3]
- if {$phase eq {}} {
- set numcommits [llength $displayorder]
- catch {unset idrowranges}
- } else {
- unflatten idrowranges [lindex $v 4]
- unflatten idinlist [lindex $v 5]
- set rowlaidout [lindex $v 6]
- set rowoptim [lindex $v 7]
- set numcommits [lindex $v 8]
- catch {unset rowchk}
- }
+ set rowisopt [lindex $v 2]
+ set rowfinal [lindex $v 3]
+ set numcommits $commitidx($n)
catch {unset colormap}
catch {unset rowtextx}
}
if {$phase ne {}} {
if {$phase eq "getcommits"} {
- show_status "Reading commits..."
+ show_status [mc "Reading commits..."]
}
run chewcommits $n
} elseif {$numcommits == 0} {
- show_status "No commits selected"
+ show_status [mc "No commits selected"]
}
}
}
proc unbolden {} {
- global mainfont boldrows
+ global boldrows
set stillbold {}
foreach row $boldrows {
if {![ishighlighted $row]} {
- bolden $row $mainfont
+ bolden $row mainfont
} else {
lappend stillbold $row
}
}
set hlview $n
if {$n != $curview && ![info exists viewdata($n)]} {
- set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
+ set viewdata($n) [list getcommits {{}} 0 0 0]
set vparentlist($n) {}
set vdisporder($n) {}
set vcmitlisted($n) {}
proc vhighlightmore {} {
global hlview vhl_done commitidx vhighlights
- global displayorder vdisporder curview mainfont
+ global displayorder vdisporder curview
- set font [concat $mainfont bold]
set max $commitidx($hlview)
if {$hlview == $curview} {
set disp $displayorder
set row $commitrow($curview,$id)
if {$r0 <= $row && $row <= $r1} {
if {![highlighted $row]} {
- bolden $row $font
+ bolden $row mainfontbold
}
set vhighlights($row) 1
}
}
proc askvhighlight {row id} {
- global hlview vhighlights commitrow iddrawn mainfont
+ global hlview vhighlights commitrow iddrawn
if {[info exists commitrow($hlview,$id)]} {
if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
- bolden $row [concat $mainfont bold]
+ bolden $row mainfontbold
}
set vhighlights($row) 1
} else {
}
}
-proc hfiles_change {name ix op} {
+proc hfiles_change {} {
global highlight_files filehighlight fhighlights fh_serial
- global mainfont highlight_paths
+ global highlight_paths gdttype
if {[info exists filehighlight]} {
# delete previous highlights
}
}
+proc gdttype_change {name ix op} {
+ global gdttype highlight_files findstring findpattern
+
+ stopfinding
+ if {$findstring ne {}} {
+ if {$gdttype eq "containing:"} {
+ if {$highlight_files ne {}} {
+ set highlight_files {}
+ hfiles_change
+ }
+ findcom_change
+ } else {
+ if {$findpattern ne {}} {
+ set findpattern {}
+ findcom_change
+ }
+ set highlight_files $findstring
+ hfiles_change
+ }
+ drawvisible
+ }
+ # enable/disable findtype/findloc menus too
+}
+
+proc find_change {name ix op} {
+ global gdttype findstring highlight_files
+
+ stopfinding
+ if {$gdttype eq "containing:"} {
+ findcom_change
+ } else {
+ if {$highlight_files ne $findstring} {
+ set highlight_files $findstring
+ hfiles_change
+ }
+ }
+ drawvisible
+}
+
+proc findcom_change args {
+ global nhighlights boldnamerows
+ global findpattern findtype findstring gdttype
+
+ stopfinding
+ # delete previous highlights, if any
+ foreach row $boldnamerows {
+ bolden_name $row mainfont
+ }
+ set boldnamerows {}
+ catch {unset nhighlights}
+ unbolden
+ unmarkmatches
+ if {$gdttype ne "containing:" || $findstring eq {}} {
+ set findpattern {}
+ } elseif {$findtype eq "Regexp"} {
+ set findpattern $findstring
+ } else {
+ set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
+ $findstring]
+ set findpattern "*$e*"
+ }
+}
+
proc makepatterns {l} {
set ret {}
foreach e $l {
set highlight_paths [makepatterns $paths]
highlight_filelist
set gdtargs [concat -- $paths]
- } else {
+ } elseif {$gdttype eq "adding/removing string:"} {
set gdtargs [list "-S$highlight_files"]
+ } else {
+ # must be "containing:", i.e. we're searching commit info
+ return
}
set cmd [concat | git diff-tree -r -s --stdin $gdtargs]
set filehighlight [open $cmd r+]
}
proc readfhighlight {} {
- global filehighlight fhighlights commitrow curview mainfont iddrawn
- global fhl_list
+ global filehighlight fhighlights commitrow curview iddrawn
+ global fhl_list find_dirn
if {![info exists filehighlight]} {
return 0
if {![info exists commitrow($curview,$line)]} continue
set row $commitrow($curview,$line)
if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
- bolden $row [concat $mainfont bold]
+ bolden $row mainfontbold
}
set fhighlights($row) 1
}
unset filehighlight
return 0
}
- next_hlcont
- return 1
-}
-
-proc find_change {name ix op} {
- global nhighlights mainfont boldnamerows
- global findstring findpattern findtype
-
- # delete previous highlights, if any
- foreach row $boldnamerows {
- bolden_name $row $mainfont
- }
- set boldnamerows {}
- catch {unset nhighlights}
- unbolden
- unmarkmatches
- if {$findtype ne "Regexp"} {
- set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
- $findstring]
- set findpattern "*$e*"
+ if {[info exists find_dirn]} {
+ run findmore
}
- drawvisible
+ return 1
}
proc doesmatch {f} {
- global findtype findstring findpattern
+ global findtype findpattern
if {$findtype eq "Regexp"} {
- return [regexp $findstring $f]
+ return [regexp $findpattern $f]
} elseif {$findtype eq "IgnCase"} {
return [string match -nocase $findpattern $f]
} else {
}
proc askfindhighlight {row id} {
- global nhighlights commitinfo iddrawn mainfont
+ global nhighlights commitinfo iddrawn
global findloc
global markingmatches
}
}
if {$isbold && [info exists iddrawn($id)]} {
- set f [concat $mainfont bold]
if {![ishighlighted $row]} {
- bolden $row $f
+ bolden $row mainfontbold
if {$isbold > 1} {
- bolden_name $row $f
+ bolden_name $row mainfontbold
}
}
if {$markingmatches} {
}
proc askrelhighlight {row id} {
- global descendent highlight_related iddrawn mainfont rhighlights
+ global descendent highlight_related iddrawn rhighlights
global selectedline ancestor
if {![info exists selectedline]} return
}
if {[info exists iddrawn($id)]} {
if {$isbold && ![ishighlighted $row]} {
- bolden $row [concat $mainfont bold]
+ bolden $row mainfontbold
}
}
set rhighlights($row) $isbold
}
-proc next_hlcont {} {
- global fhl_row fhl_dirn displayorder numcommits
- global vhighlights fhighlights nhighlights rhighlights
- global hlview filehighlight findstring highlight_related
-
- if {![info exists fhl_dirn] || $fhl_dirn == 0} return
- set row $fhl_row
- while {1} {
- if {$row < 0 || $row >= $numcommits} {
- bell
- set fhl_dirn 0
- return
- }
- set id [lindex $displayorder $row]
- if {[info exists hlview]} {
- if {![info exists vhighlights($row)]} {
- askvhighlight $row $id
- }
- if {$vhighlights($row) > 0} break
- }
- if {$findstring ne {}} {
- if {![info exists nhighlights($row)]} {
- askfindhighlight $row $id
- }
- if {$nhighlights($row) > 0} break
- }
- if {$highlight_related ne "None"} {
- if {![info exists rhighlights($row)]} {
- askrelhighlight $row $id
- }
- if {$rhighlights($row) > 0} break
- }
- if {[info exists filehighlight]} {
- if {![info exists fhighlights($row)]} {
- # ask for a few more while we're at it...
- set r $row
- for {set n 0} {$n < 100} {incr n} {
- if {![info exists fhighlights($r)]} {
- askfilehighlight $r [lindex $displayorder $r]
- }
- incr r $fhl_dirn
- if {$r < 0 || $r >= $numcommits} break
- }
- flushhighlights
- }
- if {$fhighlights($row) < 0} {
- set fhl_row $row
- return
- }
- if {$fhighlights($row) > 0} break
- }
- incr row $fhl_dirn
- }
- set fhl_dirn 0
- selectline $row 1
-}
-
-proc next_highlight {dirn} {
- global selectedline fhl_row fhl_dirn
- global hlview filehighlight findstring highlight_related
-
- if {![info exists selectedline]} return
- if {!([info exists hlview] || $findstring ne {} ||
- $highlight_related ne "None" || [info exists filehighlight])} return
- set fhl_row [expr {$selectedline + $dirn}]
- set fhl_dirn $dirn
- next_hlcont
-}
-
-proc cancel_next_highlight {} {
- global fhl_dirn
-
- set fhl_dirn 0
-}
-
# Graph layout functions
proc shortids {ids} {
return $res
}
-proc incrange {l x o} {
- set n [llength $l]
- while {$x < $n} {
- set e [lindex $l $x]
- if {$e ne {}} {
- lset l $x [expr {$e + $o}]
- }
- incr x
- }
- return $l
-}
-
proc ntimes {n o} {
set ret {}
- for {} {$n > 0} {incr n -1} {
- lappend ret $o
- }
- return $ret
-}
-
-proc usedinrange {id l1 l2} {
- global children commitrow curview
-
- if {[info exists commitrow($curview,$id)]} {
- set r $commitrow($curview,$id)
- if {$l1 <= $r && $r <= $l2} {
- return [expr {$r - $l1 + 1}]
- }
- }
- set kids $children($curview,$id)
- foreach c $kids {
- set r $commitrow($curview,$c)
- if {$l1 <= $r && $r <= $l2} {
- return [expr {$r - $l1 + 1}]
+ set o [list $o]
+ for {set mask 1} {$mask <= $n} {incr mask $mask} {
+ if {($n & $mask) != 0} {
+ set ret [concat $ret $o]
}
+ set o [concat $o $o]
}
- return 0
+ return $ret
}
# Work out where id should go in idlist so that order-token
return $i
}
-proc makeuparrow {oid y x} {
- global rowidlist uparrowlen idrowranges displayorder
-
- for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
- incr y -1
- set idl [lindex $rowidlist $y]
- set x [idcol $idl $oid $x]
- lset rowidlist $y [linsert $idl $x $oid]
- }
- lappend idrowranges($oid) [lindex $displayorder $y]
-}
-
proc initlayout {} {
- global rowidlist displayorder commitlisted
- global rowlaidout rowoptim
- global idinlist rowchk rowrangelist idrowranges
+ global rowidlist rowisopt rowfinal displayorder commitlisted
global numcommits canvxmax canv
global nextcolor
global parentlist
set displayorder {}
set commitlisted {}
set parentlist {}
- set rowrangelist {}
set nextcolor 0
- set rowidlist {{}}
- catch {unset idinlist}
- catch {unset rowchk}
- set rowlaidout 0
- set rowoptim 0
+ set rowidlist {}
+ set rowisopt {}
+ set rowfinal {}
set canvxmax [$canv cget -width]
catch {unset colormap}
catch {unset rowtextx}
- catch {unset idrowranges}
set selectfirst 1
}
return [list $r0 $r1]
}
-proc layoutmore {tmax allread} {
- global rowlaidout rowoptim commitidx numcommits optim_delay
- global uparrowlen curview rowidlist idinlist
+proc layoutmore {} {
+ global commitidx viewcomplete numcommits
+ global uparrowlen downarrowlen mingaplen curview
- set showlast 0
- set showdelay $optim_delay
- set optdelay [expr {$uparrowlen + 1}]
- while {1} {
- if {$rowoptim - $showdelay > $numcommits} {
- showstuff [expr {$rowoptim - $showdelay}] $showlast
- } elseif {$rowlaidout - $optdelay > $rowoptim} {
- set nr [expr {$rowlaidout - $optdelay - $rowoptim}]
- if {$nr > 100} {
- set nr 100
- }
- optimize_rows $rowoptim 0 [expr {$rowoptim + $nr}]
- incr rowoptim $nr
- } elseif {$commitidx($curview) > $rowlaidout} {
- set nr [expr {$commitidx($curview) - $rowlaidout}]
- # may need to increase this threshold if uparrowlen or
- # mingaplen are increased...
- if {$nr > 200} {
- set nr 200
- }
- set row $rowlaidout
- set rowlaidout [layoutrows $row [expr {$row + $nr}] $allread]
- if {$rowlaidout == $row} {
- return 0
- }
- } elseif {$allread} {
- set optdelay 0
- set nrows $commitidx($curview)
- if {[lindex $rowidlist $nrows] ne {} ||
- [array names idinlist] ne {}} {
- layouttail
- set rowlaidout $commitidx($curview)
- } elseif {$rowoptim == $nrows} {
- set showdelay 0
- set showlast 1
- if {$numcommits == $nrows} {
- return 0
- }
- }
- } else {
- return 0
- }
- if {$tmax ne {} && [clock clicks -milliseconds] >= $tmax} {
- return 1
- }
+ set show $commitidx($curview)
+ if {$show > $numcommits || $viewcomplete($curview)} {
+ showstuff $show $viewcomplete($curview)
}
}
proc showstuff {canshow last} {
global numcommits commitrow pending_select selectedline curview
- global lookingforhead mainheadid displayorder selectfirst
- global lastscrollset
+ global mainheadid displayorder selectfirst
+ global lastscrollset commitinterest
if {$numcommits == 0} {
global phase
set selectfirst 0
}
}
- if {$lookingforhead && [info exists commitrow($curview,$mainheadid)]
- && ($last || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
- set lookingforhead 0
- dodiffindex
- }
}
proc doshowlocalchanges {} {
- global lookingforhead curview mainheadid phase commitrow
+ global curview mainheadid phase commitrow
if {[info exists commitrow($curview,$mainheadid)] &&
($phase eq {} || $commitrow($curview,$mainheadid) < $numcommits - 1)} {
dodiffindex
} elseif {$phase ne {}} {
- set lookingforhead 1
+ lappend commitinterest($mainheadid) {}
}
}
proc dohidelocalchanges {} {
- global lookingforhead localfrow localirow lserial
+ global localfrow localirow lserial
- set lookingforhead 0
if {$localfrow >= 0} {
removerow $localfrow
set localfrow -1
# spawn off a process to do git diff-index --cached HEAD
proc dodiffindex {} {
- global localirow localfrow lserial
+ global localirow localfrow lserial showlocalchanges
+ if {!$showlocalchanges} return
incr lserial
set localfrow -1
set localirow -1
if {$isdiff && $serial == $lserial && $localirow == -1} {
# add the line for the changes in the index to the graph
set localirow $commitrow($curview,$mainheadid)
- set hl "Local changes checked in to index but not committed"
+ set hl [mc "Local changes checked in to index but not committed"]
set commitinfo($nullid2) [list $hl {} {} {} {} " $hl\n"]
set commitdata($nullid2) "\n $hl\n"
insertrow $localirow $nullid2
} else {
set localfrow $commitrow($curview,$mainheadid)
}
- set hl "Local uncommitted changes, not checked in to index"
+ set hl [mc "Local uncommitted changes, not checked in to index"]
set commitinfo($nullid) [list $hl {} {} {} {} " $hl\n"]
set commitdata($nullid) "\n $hl\n"
insertrow $localfrow $nullid
return 0
}
-proc layoutrows {row endrow last} {
- global rowidlist displayorder
+proc nextuse {id row} {
+ global commitrow curview children
+
+ if {[info exists children($curview,$id)]} {
+ foreach kid $children($curview,$id) {
+ if {![info exists commitrow($curview,$kid)]} {
+ return -1
+ }
+ if {$commitrow($curview,$kid) > $row} {
+ return $commitrow($curview,$kid)
+ }
+ }
+ }
+ if {[info exists commitrow($curview,$id)]} {
+ return $commitrow($curview,$id)
+ }
+ return -1
+}
+
+proc prevuse {id row} {
+ global commitrow curview children
+
+ set ret -1
+ if {[info exists children($curview,$id)]} {
+ foreach kid $children($curview,$id) {
+ if {![info exists commitrow($curview,$kid)]} break
+ if {$commitrow($curview,$kid) < $row} {
+ set ret $commitrow($curview,$kid)
+ }
+ }
+ }
+ return $ret
+}
+
+proc make_idlist {row} {
+ global displayorder parentlist uparrowlen downarrowlen mingaplen
+ global commitidx curview ordertok children commitrow
+
+ set r [expr {$row - $mingaplen - $downarrowlen - 1}]
+ if {$r < 0} {
+ set r 0
+ }
+ set ra [expr {$row - $downarrowlen}]
+ if {$ra < 0} {
+ set ra 0
+ }
+ set rb [expr {$row + $uparrowlen}]
+ if {$rb > $commitidx($curview)} {
+ set rb $commitidx($curview)
+ }
+ set ids {}
+ for {} {$r < $ra} {incr r} {
+ set nextid [lindex $displayorder [expr {$r + 1}]]
+ foreach p [lindex $parentlist $r] {
+ if {$p eq $nextid} continue
+ set rn [nextuse $p $r]
+ if {$rn >= $row &&
+ $rn <= $r + $downarrowlen + $mingaplen + $uparrowlen} {
+ lappend ids [list $ordertok($curview,$p) $p]
+ }
+ }
+ }
+ for {} {$r < $row} {incr r} {
+ set nextid [lindex $displayorder [expr {$r + 1}]]
+ foreach p [lindex $parentlist $r] {
+ if {$p eq $nextid} continue
+ set rn [nextuse $p $r]
+ if {$rn < 0 || $rn >= $row} {
+ lappend ids [list $ordertok($curview,$p) $p]
+ }
+ }
+ }
+ set id [lindex $displayorder $row]
+ lappend ids [list $ordertok($curview,$id) $id]
+ while {$r < $rb} {
+ foreach p [lindex $parentlist $r] {
+ set firstkid [lindex $children($curview,$p) 0]
+ if {$commitrow($curview,$firstkid) < $row} {
+ lappend ids [list $ordertok($curview,$p) $p]
+ }
+ }
+ incr r
+ set id [lindex $displayorder $r]
+ if {$id ne {}} {
+ set firstkid [lindex $children($curview,$id) 0]
+ if {$firstkid ne {} && $commitrow($curview,$firstkid) < $row} {
+ lappend ids [list $ordertok($curview,$id) $id]
+ }
+ }
+ }
+ set idlist {}
+ foreach idx [lsort -unique $ids] {
+ lappend idlist [lindex $idx 1]
+ }
+ return $idlist
+}
+
+proc rowsequal {a b} {
+ while {[set i [lsearch -exact $a {}]] >= 0} {
+ set a [lreplace $a $i $i]
+ }
+ while {[set i [lsearch -exact $b {}]] >= 0} {
+ set b [lreplace $b $i $i]
+ }
+ return [expr {$a eq $b}]
+}
+
+proc makeupline {id row rend col} {
+ global rowidlist uparrowlen downarrowlen mingaplen
+
+ for {set r $rend} {1} {set r $rstart} {
+ set rstart [prevuse $id $r]
+ if {$rstart < 0} return
+ if {$rstart < $row} break
+ }
+ if {$rstart + $uparrowlen + $mingaplen + $downarrowlen < $rend} {
+ set rstart [expr {$rend - $uparrowlen - 1}]
+ }
+ for {set r $rstart} {[incr r] <= $row} {} {
+ set idlist [lindex $rowidlist $r]
+ if {$idlist ne {} && [lsearch -exact $idlist $id] < 0} {
+ set col [idcol $idlist $id $col]
+ lset rowidlist $r [linsert $idlist $col $id]
+ changedrow $r
+ }
+ }
+}
+
+proc layoutrows {row endrow} {
+ global rowidlist rowisopt rowfinal displayorder
global uparrowlen downarrowlen maxwidth mingaplen
global children parentlist
- global idrowranges
- global commitidx curview
- global idinlist rowchk rowrangelist
-
- set idlist [lindex $rowidlist $row]
- while {$row < $endrow} {
- set id [lindex $displayorder $row]
- set oldolds {}
- set newolds {}
- set olds [lindex $parentlist $row]
- foreach p $olds {
- if {![info exists idinlist($p)]} {
- lappend newolds $p
- } elseif {!$idinlist($p)} {
- lappend oldolds $p
- }
- }
- set nev [expr {[llength $idlist] + [llength $newolds]
- + [llength $oldolds] - $maxwidth + 1}]
- if {1 || $nev > 0} {
- if {!$last &&
- $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
- for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
- set i [lindex $idlist $x]
- if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
- set r [usedinrange $i [expr {$row - $downarrowlen}] \
- [expr {$row + $uparrowlen + $mingaplen}]]
- if {$r == 0} {
- set idlist [lreplace $idlist $x $x]
- set idinlist($i) 0
- set rm1 [expr {$row - 1}]
- lappend idrowranges($i) [lindex $displayorder $rm1]
- #if {[incr nev -1] <= 0} break
- continue
+ global commitidx viewcomplete curview commitrow
+
+ set idlist {}
+ if {$row > 0} {
+ set rm1 [expr {$row - 1}]
+ foreach id [lindex $rowidlist $rm1] {
+ if {$id ne {}} {
+ lappend idlist $id
+ }
+ }
+ set final [lindex $rowfinal $rm1]
+ }
+ for {} {$row < $endrow} {incr row} {
+ set rm1 [expr {$row - 1}]
+ if {$rm1 < 0 || $idlist eq {}} {
+ set idlist [make_idlist $row]
+ set final 1
+ } else {
+ set id [lindex $displayorder $rm1]
+ set col [lsearch -exact $idlist $id]
+ set idlist [lreplace $idlist $col $col]
+ foreach p [lindex $parentlist $rm1] {
+ if {[lsearch -exact $idlist $p] < 0} {
+ set col [idcol $idlist $p $col]
+ set idlist [linsert $idlist $col $p]
+ # if not the first child, we have to insert a line going up
+ if {$id ne [lindex $children($curview,$p) 0]} {
+ makeupline $p $rm1 $row $col
+ }
+ }
+ }
+ set id [lindex $displayorder $row]
+ if {$row > $downarrowlen} {
+ set termrow [expr {$row - $downarrowlen - 1}]
+ foreach p [lindex $parentlist $termrow] {
+ set i [lsearch -exact $idlist $p]
+ if {$i < 0} continue
+ set nr [nextuse $p $termrow]
+ if {$nr < 0 || $nr >= $row + $mingaplen + $uparrowlen} {
+ set idlist [lreplace $idlist $i $i]
+ }
+ }
+ }
+ set col [lsearch -exact $idlist $id]
+ if {$col < 0} {
+ set col [idcol $idlist $id]
+ set idlist [linsert $idlist $col $id]
+ if {$children($curview,$id) ne {}} {
+ makeupline $id $rm1 $row $col
+ }
+ }
+ set r [expr {$row + $uparrowlen - 1}]
+ if {$r < $commitidx($curview)} {
+ set x $col
+ foreach p [lindex $parentlist $r] {
+ if {[lsearch -exact $idlist $p] >= 0} continue
+ set fk [lindex $children($curview,$p) 0]
+ if {$commitrow($curview,$fk) < $row} {
+ set x [idcol $idlist $p $x]
+ set idlist [linsert $idlist $x $p]
+ }
+ }
+ if {[incr r] < $commitidx($curview)} {
+ set p [lindex $displayorder $r]
+ if {[lsearch -exact $idlist $p] < 0} {
+ set fk [lindex $children($curview,$p) 0]
+ if {$fk ne {} && $commitrow($curview,$fk) < $row} {
+ set x [idcol $idlist $p $x]
+ set idlist [linsert $idlist $x $p]
+ }
}
- set rowchk($id) [expr {$row + $r}]
}
}
- lset rowidlist $row $idlist
}
- set col [lsearch -exact $idlist $id]
- if {$col < 0} {
- set col [idcol $idlist $id]
- set idlist [linsert $idlist $col $id]
- lset rowidlist $row $idlist
- if {$children($curview,$id) ne {}} {
- unset idinlist($id)
- makeuparrow $id $row $col
+ if {$final && !$viewcomplete($curview) &&
+ $row + $uparrowlen + $mingaplen + $downarrowlen
+ >= $commitidx($curview)} {
+ set final 0
+ }
+ set l [llength $rowidlist]
+ if {$row == $l} {
+ lappend rowidlist $idlist
+ lappend rowisopt 0
+ lappend rowfinal $final
+ } elseif {$row < $l} {
+ if {![rowsequal $idlist [lindex $rowidlist $row]]} {
+ lset rowidlist $row $idlist
+ changedrow $row
}
+ lset rowfinal $row $final
} else {
- unset idinlist($id)
- }
- set ranges {}
- if {[info exists idrowranges($id)]} {
- set ranges $idrowranges($id)
- lappend ranges $id
- unset idrowranges($id)
- }
- lappend rowrangelist $ranges
- incr row
- set idlist [lreplace $idlist $col $col]
- set x $col
- foreach i $newolds {
- set x [idcol $idlist $i $x]
- set idlist [linsert $idlist $x $i]
- set idinlist($i) 1
- set idrowranges($i) $id
- }
- foreach oid $oldolds {
- set idinlist($oid) 1
- set x [idcol $idlist $oid $x]
- set idlist [linsert $idlist $x $oid]
- makeuparrow $oid $row $x
- }
- lappend rowidlist $idlist
+ set pad [ntimes [expr {$row - $l}] {}]
+ set rowidlist [concat $rowidlist $pad]
+ lappend rowidlist $idlist
+ set rowfinal [concat $rowfinal $pad]
+ lappend rowfinal $final
+ set rowisopt [concat $rowisopt [ntimes [expr {$row - $l + 1}] 0]]
+ }
}
return $row
}
-proc addextraid {id row} {
- global displayorder commitrow commitinfo
- global commitidx commitlisted
- global parentlist children curview
+proc changedrow {row} {
+ global displayorder iddrawn rowisopt need_redisplay
- incr commitidx($curview)
- lappend displayorder $id
- lappend commitlisted 0
- lappend parentlist {}
- set commitrow($curview,$id) $row
- readcommit $id
- if {![info exists commitinfo($id)]} {
- set commitinfo($id) {"No commit information available"}
- }
- if {![info exists children($curview,$id)]} {
- set children($curview,$id) {}
+ set l [llength $rowisopt]
+ if {$row < $l} {
+ lset rowisopt $row 0
+ if {$row + 1 < $l} {
+ lset rowisopt [expr {$row + 1}] 0
+ if {$row + 2 < $l} {
+ lset rowisopt [expr {$row + 2}] 0
+ }
+ }
}
-}
-
-proc layouttail {} {
- global rowidlist idinlist commitidx curview
- global idrowranges rowrangelist
-
- set row $commitidx($curview)
- set idlist [lindex $rowidlist $row]
- while {$idlist ne {}} {
- set col [expr {[llength $idlist] - 1}]
- set id [lindex $idlist $col]
- addextraid $id $row
- unset idinlist($id)
- lappend idrowranges($id) $id
- lappend rowrangelist $idrowranges($id)
- unset idrowranges($id)
- incr row
- set idlist [lreplace $idlist $col $col]
- lappend rowidlist $idlist
- }
-
- foreach id [array names idinlist] {
- unset idinlist($id)
- addextraid $id $row
- lset rowidlist $row [list $id]
- makeuparrow $id $row 0
- lappend idrowranges($id) $id
- lappend rowrangelist $idrowranges($id)
- unset idrowranges($id)
- incr row
- lappend rowidlist {}
+ set id [lindex $displayorder $row]
+ if {[info exists iddrawn($id)]} {
+ set need_redisplay 1
}
}
global rowidlist
set pad [ntimes $npad {}]
- lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
+ set idlist [lindex $rowidlist $row]
+ set bef [lrange $idlist 0 [expr {$col - 1}]]
+ set aft [lrange $idlist $col end]
+ set i [lsearch -exact $aft {}]
+ if {$i > 0} {
+ set aft [lreplace $aft $i $i]
+ }
+ lset rowidlist $row [concat $bef $pad $aft]
+ changedrow $row
}
proc optimize_rows {row col endrow} {
- global rowidlist displayorder
+ global rowidlist rowisopt displayorder curview children
if {$row < 1} {
set row 1
}
- set idlist [lindex $rowidlist [expr {$row - 1}]]
- if {$row >= 2} {
- set previdlist [lindex $rowidlist [expr {$row - 2}]]
- } else {
- set previdlist {}
- }
- for {} {$row < $endrow} {incr row} {
- set pprevidlist $previdlist
- set previdlist $idlist
- set idlist [lindex $rowidlist $row]
+ for {} {$row < $endrow} {incr row; set col 0} {
+ if {[lindex $rowisopt $row]} continue
set haspad 0
set y0 [expr {$row - 1}]
set ym [expr {$row - 2}]
+ set idlist [lindex $rowidlist $row]
+ set previdlist [lindex $rowidlist $y0]
+ if {$idlist eq {} || $previdlist eq {}} continue
+ if {$ym >= 0} {
+ set pprevidlist [lindex $rowidlist $ym]
+ if {$pprevidlist eq {}} continue
+ } else {
+ set pprevidlist {}
+ }
set x0 -1
set xm -1
for {} {$col < [llength $idlist]} {incr col} {
}
}
if {$z0 eq {}} {
- set ranges [rowranges $id]
- if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
+ # if row y0 is the first child of $id then it's not an arrow
+ if {[lindex $children($curview,$id) 0] ne
+ [lindex $displayorder $y0]} {
set isarrow 1
}
}
+ if {!$isarrow && $id ne [lindex $displayorder $row] &&
+ [lsearch -exact [lindex $rowidlist [expr {$row+1}]] $id] < 0} {
+ set isarrow 1
+ }
# Looking at lines from this row to the previous row,
# make them go straight up if they end in an arrow on
# the previous row; otherwise make them go straight up
# Line currently goes right too much;
# insert pads in this line
set npad [expr {$z - 1 + $isarrow}]
- set pad [ntimes $npad {}]
- set idlist [eval linsert \$idlist $col $pad]
+ insert_pad $row $col $npad
+ set idlist [lindex $rowidlist $row]
incr col $npad
set z [expr {$x0 - $col}]
set haspad 1
incr x0
optimize_rows $y0 $x0 $row
set previdlist [lindex $rowidlist $y0]
- set pprevidlist [lindex $rowidlist $ym]
}
}
if {!$haspad} {
set x0 [lsearch -exact $previdlist $id]
if {$x0 < 0} {
# check if this is the link to the first child
- set ranges [rowranges $id]
- if {$ranges ne {} && $row == [lindex $ranges 0]} {
+ set kid [lindex $displayorder $y0]
+ if {[lindex $children($curview,$id) 0] eq $kid} {
# it is, work out offset to child
- set id [lindex $displayorder $y0]
- set x0 [lsearch -exact $previdlist $id]
+ set x0 [lsearch -exact $previdlist $kid]
}
}
if {$x0 <= $col} break
# isn't the last column
if {$x0 >= 0 && [incr col] < [llength $idlist]} {
set idlist [linsert $idlist $col {}]
+ lset rowidlist $row $idlist
+ changedrow $row
}
}
- lset rowidlist $row $idlist
- set col 0
}
}
}
proc rowranges {id} {
- global phase idrowranges commitrow rowlaidout rowrangelist curview
-
- set ranges {}
- if {$phase eq {} ||
- ([info exists commitrow($curview,$id)]
- && $commitrow($curview,$id) < $rowlaidout)} {
- set ranges [lindex $rowrangelist $commitrow($curview,$id)]
- } elseif {[info exists idrowranges($id)]} {
- set ranges $idrowranges($id)
- }
- set linenos {}
- foreach rid $ranges {
- lappend linenos $commitrow($curview,$rid)
- }
- if {$linenos ne {}} {
- lset linenos 0 [expr {[lindex $linenos 0] + 1}]
- }
- return $linenos
-}
-
-# work around tk8.4 refusal to draw arrows on diagonal segments
-proc adjarrowhigh {coords} {
- global linespc
-
- set x0 [lindex $coords 0]
- set x1 [lindex $coords 2]
- if {$x0 != $x1} {
- set y0 [lindex $coords 1]
- set y1 [lindex $coords 3]
- if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
- # we have a nearby vertical segment, just trim off the diag bit
- set coords [lrange $coords 2 end]
+ global commitrow curview children uparrowlen downarrowlen
+ global rowidlist
+
+ set kids $children($curview,$id)
+ if {$kids eq {}} {
+ return {}
+ }
+ set ret {}
+ lappend kids $id
+ foreach child $kids {
+ if {![info exists commitrow($curview,$child)]} break
+ set row $commitrow($curview,$child)
+ if {![info exists prev]} {
+ lappend ret [expr {$row + 1}]
} else {
- set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
- set xi [expr {$x0 - $slope * $linespc / 2}]
- set yi [expr {$y0 - $linespc / 2}]
- set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
+ if {$row <= $prevrow} {
+ puts "oops children out of order [shortids $id] $row < [shortids $prev] $prevrow"
+ }
+ # see if the line extends the whole way from prevrow to row
+ if {$row > $prevrow + $uparrowlen + $downarrowlen &&
+ [lsearch -exact [lindex $rowidlist \
+ [expr {int(($row + $prevrow) / 2)}]] $id] < 0} {
+ # it doesn't, see where it ends
+ set r [expr {$prevrow + $downarrowlen}]
+ if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
+ while {[incr r -1] > $prevrow &&
+ [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
+ } else {
+ while {[incr r] <= $row &&
+ [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
+ incr r -1
+ }
+ lappend ret $r
+ # see where it starts up again
+ set r [expr {$row - $uparrowlen}]
+ if {[lsearch -exact [lindex $rowidlist $r] $id] < 0} {
+ while {[incr r] < $row &&
+ [lsearch -exact [lindex $rowidlist $r] $id] < 0} {}
+ } else {
+ while {[incr r -1] >= $prevrow &&
+ [lsearch -exact [lindex $rowidlist $r] $id] >= 0} {}
+ incr r
+ }
+ lappend ret $r
+ }
+ }
+ if {$child eq $id} {
+ lappend ret $row
}
+ set prev $id
+ set prevrow $row
}
- return $coords
+ return $ret
}
proc drawlineseg {id row endrow arrowlow} {
global rowidlist displayorder iddrawn linesegs
- global canv colormap linespc curview maxlinelen
+ global canv colormap linespc curview maxlinelen parentlist
set cols [list [lsearch -exact [lindex $rowidlist $row] $id]]
set le [expr {$row + 1}]
set itl [lindex $lines [expr {$i-1}] 2]
set al [$canv itemcget $itl -arrow]
set arrowlow [expr {$al eq "last" || $al eq "both"}]
- } elseif {$arrowlow &&
- [lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0} {
- set arrowlow 0
+ } elseif {$arrowlow} {
+ if {[lsearch -exact [lindex $rowidlist [expr {$row-1}]] $id] >= 0 ||
+ [lsearch -exact [lindex $parentlist [expr {$row-1}]] $id] >= 0} {
+ set arrowlow 0
+ }
}
set arrow [lindex {none first last both} [expr {$arrowhigh + 2*$arrowlow}]]
for {set y $le} {[incr y -1] > $row} {} {
set xc [lsearch -exact [lindex $rowidlist $row] $ch]
if {$xc < 0} {
puts "oops: drawlineseg: child $ch not on row $row"
- } else {
- if {$xc < $x - 1} {
+ } elseif {$xc != $x} {
+ if {($arrowhigh && $le == $row + 1) || $dir == 0} {
+ set d [expr {int(0.5 * $linespc)}]
+ set x1 [xc $row $x]
+ if {$xc < $x} {
+ set x2 [expr {$x1 - $d}]
+ } else {
+ set x2 [expr {$x1 + $d}]
+ }
+ set y2 [yc $row]
+ set y1 [expr {$y2 + $d}]
+ lappend coords $x1 $y1 $x2 $y2
+ } elseif {$xc < $x - 1} {
lappend coords [xc $row [expr {$x-1}]] [yc $row]
} elseif {$xc > $x + 1} {
lappend coords [xc $row [expr {$x+1}]] [yc $row]
} else {
set xn [xc $row $xp]
set yn [yc $row]
- # work around tk8.4 refusal to draw arrows on diagonal segments
- if {$arrowlow && $xn != [lindex $coords end-1]} {
- if {[llength $coords] < 4 ||
- [lindex $coords end-3] != [lindex $coords end-1] ||
- [lindex $coords end] - $yn > 2 * $linespc} {
- set xn [xc $row [expr {$xp - 0.5 * $dir}]]
- set yo [yc [expr {$row + 0.5}]]
- lappend coords $xn $yo $xn $yn
- }
- } else {
- lappend coords $xn $yn
- }
+ lappend coords $xn $yn
}
if {!$joinhigh} {
- if {$arrowhigh} {
- set coords [adjarrowhigh $coords]
- }
assigncolor $id
set t [$canv create line $coords -width [linewidth $id] \
-fill $colormap($id) -tags lines.$id -arrow $arrow]
set coords [concat $coords $clow]
if {!$joinhigh} {
lset lines [expr {$i-1}] 1 $le
- if {$arrowhigh} {
- set coords [adjarrowhigh $coords]
- }
} else {
# coalesce two pieces
$canv delete $ith
set x [xc $row $col]
set y [yc $row]
set y2 [yc $row2]
- set d [expr {int(0.4 * $linespc)}]
+ set d [expr {int(0.5 * $linespc)}]
set ymid [expr {$y + $d}]
set ids [lindex $rowidlist $row2]
# rmx = right-most X coord used
global linespc canv canv2 canv3 canvy0 fgcolor curview
global commitlisted commitinfo rowidlist parentlist
global rowtextx idpos idtags idheads idotherrefs
- global linehtag linentag linedtag
- global mainfont canvxmax boldrows boldnamerows fgcolor nullid nullid2
+ global linehtag linentag linedtag selectedline
+ global canvxmax boldrows boldnamerows fgcolor nullid nullid2
# listed is 0 for boundary, 1 for normal, 2 for left, 3 for right
set listed [lindex $commitlisted $row]
set name [lindex $commitinfo($id) 1]
set date [lindex $commitinfo($id) 2]
set date [formatdate $date]
- set font $mainfont
- set nfont $mainfont
+ set font mainfont
+ set nfont mainfont
set isbold [ishighlighted $row]
if {$isbold > 0} {
lappend boldrows $row
- lappend font bold
+ set font mainfontbold
if {$isbold > 1} {
lappend boldnamerows $row
- lappend nfont bold
+ set nfont mainfontbold
}
}
set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
-text $name -font $nfont -tags text]
set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
- -text $date -font $mainfont -tags text]
- set xr [expr {$xt + [font measure $mainfont $headline]}]
+ -text $date -font mainfont -tags text]
+ if {[info exists selectedline] && $selectedline == $row} {
+ make_secsel $row
+ }
+ set xr [expr {$xt + [font measure $font $headline]}]
if {$xr > $canvxmax} {
set canvxmax $xr
setcanvscroll
}
proc drawcmitrow {row} {
- global displayorder rowidlist
+ global displayorder rowidlist nrows_drawn
global iddrawn markingmatches
global commitinfo parentlist numcommits
- global filehighlight fhighlights findstring nhighlights
+ global filehighlight fhighlights findpattern nhighlights
global hlview vhighlights
global highlight_related rhighlights
if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
askfilehighlight $row $id
}
- if {$findstring ne {} && ![info exists nhighlights($row)]} {
+ if {$findpattern ne {} && ![info exists nhighlights($row)]} {
askfindhighlight $row $id
}
if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
assigncolor $id
drawcmittext $id $row $col
set iddrawn($id) 1
+ incr nrows_drawn
}
if {$markingmatches} {
markrowmatches $row $id
}
proc drawcommits {row {endrow {}}} {
- global numcommits iddrawn displayorder curview
- global parentlist rowidlist
+ global numcommits iddrawn displayorder curview need_redisplay
+ global parentlist rowidlist rowfinal uparrowlen downarrowlen nrows_drawn
if {$row < 0} {
set row 0
set endrow [expr {$numcommits - 1}]
}
+ set rl1 [expr {$row - $downarrowlen - 3}]
+ if {$rl1 < 0} {
+ set rl1 0
+ }
+ set ro1 [expr {$row - 3}]
+ if {$ro1 < 0} {
+ set ro1 0
+ }
+ set r2 [expr {$endrow + $uparrowlen + 3}]
+ if {$r2 > $numcommits} {
+ set r2 $numcommits
+ }
+ for {set r $rl1} {$r < $r2} {incr r} {
+ if {[lindex $rowidlist $r] ne {} && [lindex $rowfinal $r]} {
+ if {$rl1 < $r} {
+ layoutrows $rl1 $r
+ }
+ set rl1 [expr {$r + 1}]
+ }
+ }
+ if {$rl1 < $r} {
+ layoutrows $rl1 $r
+ }
+ optimize_rows $ro1 0 $r2
+ if {$need_redisplay || $nrows_drawn > 2000} {
+ clear_display
+ drawvisible
+ }
+
# make the lines join to already-drawn rows either side
set r [expr {$row - 1}]
if {$r < 0 || ![info exists iddrawn([lindex $displayorder $r])]} {
drawcmitrow $r
if {$r == $er} break
set nextid [lindex $displayorder [expr {$r + 1}]]
- if {$wasdrawn && [info exists iddrawn($nextid)]} {
- catch {unset prevlines}
- continue
- }
+ if {$wasdrawn && [info exists iddrawn($nextid)]} continue
drawparentlinks $id $r
- if {[info exists lineends($r)]} {
- foreach lid $lineends($r) {
- unset prevlines($lid)
- }
- }
set rowids [lindex $rowidlist $r]
foreach lid $rowids {
if {$lid eq {}} continue
+ if {[info exists lineend($lid)] && $lineend($lid) > $r} continue
if {$lid eq $id} {
# see if this is the first child of any of its parents
foreach p [lindex $parentlist $r] {
if {[lsearch -exact $rowids $p] < 0} {
# make this line extend up to the child
- set le [drawlineseg $p $r $er 0]
- lappend lineends($le) $p
- set prevlines($p) 1
+ set lineend($p) [drawlineseg $p $r $er 0]
}
}
- } elseif {![info exists prevlines($lid)]} {
- set le [drawlineseg $lid $r $er 1]
- lappend lineends($le) $lid
- set prevlines($lid) 1
+ } else {
+ set lineend($lid) [drawlineseg $lid $r $er 1]
}
}
}
}
proc clear_display {} {
- global iddrawn linesegs
+ global iddrawn linesegs need_redisplay nrows_drawn
global vhighlights fhighlights nhighlights rhighlights
allcanvs delete all
catch {unset fhighlights}
catch {unset nhighlights}
catch {unset rhighlights}
+ set need_redisplay 0
+ set nrows_drawn 0
}
proc findcrossings {id} {
proc drawtags {id x xt y1} {
global idtags idheads idotherrefs mainhead
global linespc lthickness
- global canv mainfont commitrow rowtextx curview fgcolor bgcolor
+ global canv commitrow rowtextx curview fgcolor bgcolor
set marks {}
set ntags 0
foreach tag $marks {
incr i
if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
- set wid [font measure [concat $mainfont bold] $tag]
+ set wid [font measure mainfontbold $tag]
} else {
- set wid [font measure $mainfont $tag]
+ set wid [font measure mainfont $tag]
}
lappend xvals $xt
lappend wvals $wid
foreach tag $marks x $xvals wid $wvals {
set xl [expr {$x + $delta}]
set xr [expr {$x + $delta + $wid + $lthickness}]
- set font $mainfont
+ set font mainfont
if {[incr ntags -1] >= 0} {
# draw a tag
set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
if {[incr nheads -1] >= 0} {
set col green
if {$tag eq $mainhead} {
- lappend font bold
+ set font mainfontbold
}
} else {
set col "#ddddff"
$canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
-width 1 -outline black -fill $col -tags tag.$id
if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
- set rwid [font measure $mainfont $remoteprefix]
+ set rwid [font measure mainfont $remoteprefix]
set xi [expr {$x + 1}]
set yti [expr {$yt + 1}]
set xri [expr {$x + $rwid}]
}
proc show_status {msg} {
- global canv mainfont fgcolor
+ global canv fgcolor
clear_display
- $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
+ $canv create text 3 3 -anchor nw -text $msg -font mainfont \
-tags text -fill $fgcolor
}
# on that row and below will move down one row.
proc insertrow {row newcmit} {
global displayorder parentlist commitlisted children
- global commitrow curview rowidlist numcommits
- global rowrangelist rowlaidout rowoptim numcommits
- global selectedline rowchk commitidx
+ global commitrow curview rowidlist rowisopt rowfinal numcommits
+ global numcommits
+ global selectedline commitidx ordertok
if {$row >= $numcommits} {
puts "oops, inserting new row $row but only have $numcommits rows"
set commitrow($curview,$id) $r
}
incr commitidx($curview)
+ set ordertok($curview,$newcmit) $ordertok($curview,$p)
- set idlist [lindex $rowidlist $row]
- if {[llength $kids] == 1} {
- set col [lsearch -exact $idlist $p]
- lset idlist $col $newcmit
- } else {
- set col [llength $idlist]
- lappend idlist $newcmit
- }
- set rowidlist [linsert $rowidlist $row $idlist]
-
- set rowrangelist [linsert $rowrangelist $row {}]
- if {[llength $kids] > 1} {
- set rp1 [expr {$row + 1}]
- set ranges [lindex $rowrangelist $rp1]
- if {$ranges eq {}} {
- set ranges [list $newcmit $p]
- } elseif {[lindex $ranges end-1] eq $p} {
- lset ranges end-1 $newcmit
+ if {$row < [llength $rowidlist]} {
+ set idlist [lindex $rowidlist $row]
+ if {$idlist ne {}} {
+ if {[llength $kids] == 1} {
+ set col [lsearch -exact $idlist $p]
+ lset idlist $col $newcmit
+ } else {
+ set col [llength $idlist]
+ lappend idlist $newcmit
+ }
}
- lset rowrangelist $rp1 $ranges
+ set rowidlist [linsert $rowidlist $row $idlist]
+ set rowisopt [linsert $rowisopt $row 0]
+ set rowfinal [linsert $rowfinal $row [lindex $rowfinal $row]]
}
- catch {unset rowchk}
-
- incr rowlaidout
- incr rowoptim
incr numcommits
if {[info exists selectedline] && $selectedline >= $row} {
# Remove a commit that was inserted with insertrow on row $row.
proc removerow {row} {
global displayorder parentlist commitlisted children
- global commitrow curview rowidlist numcommits
- global rowrangelist idrowranges rowlaidout rowoptim numcommits
- global linesegends selectedline rowchk commitidx
+ global commitrow curview rowidlist rowisopt rowfinal numcommits
+ global numcommits
+ global linesegends selectedline commitidx
if {$row >= $numcommits} {
puts "oops, removing row $row but only have $numcommits rows"
}
incr commitidx($curview) -1
- set rowidlist [lreplace $rowidlist $row $row]
-
- set rowrangelist [lreplace $rowrangelist $row $row]
- if {[llength $kids] > 0} {
- set ranges [lindex $rowrangelist $row]
- if {[lindex $ranges end-1] eq $id} {
- set ranges [lreplace $ranges end-1 end]
- lset rowrangelist $row $ranges
- }
+ if {$row < [llength $rowidlist]} {
+ set rowidlist [lreplace $rowidlist $row $row]
+ set rowisopt [lreplace $rowisopt $row $row]
+ set rowfinal [lreplace $rowfinal $row $row]
}
- catch {unset rowchk}
-
- incr rowlaidout -1
- incr rowoptim -1
incr numcommits -1
if {[info exists selectedline] && $selectedline > $row} {
set curtextcursor $c
}
-proc nowbusy {what} {
- global isbusy
+proc nowbusy {what {name {}}} {
+ global isbusy busyname statusw
if {[array names isbusy] eq {}} {
. config -cursor watch
settextcursor watch
}
set isbusy($what) 1
+ set busyname($what) $name
+ if {$name ne {}} {
+ $statusw conf -text $name
+ }
}
proc notbusy {what} {
- global isbusy maincursor textcursor
+ global isbusy maincursor textcursor busyname statusw
- catch {unset isbusy($what)}
+ catch {
+ unset isbusy($what)
+ if {$busyname($what) ne {} &&
+ [$statusw cget -text] eq $busyname($what)} {
+ $statusw conf -text {}
+ }
+ }
if {[array names isbusy] eq {}} {
. config -cursor $maincursor
settextcursor $textcursor
return $matches
}
-proc dofind {{rev 0}} {
+proc dofind {{dirn 1} {wrap 1}} {
global findstring findstartline findcurline selectedline numcommits
+ global gdttype filehighlight fh_serial find_dirn findallowwrap
- unmarkmatches
- cancel_next_highlight
+ if {[info exists find_dirn]} {
+ if {$find_dirn == $dirn} return
+ stopfinding
+ }
focus .
if {$findstring eq {} || $numcommits == 0} return
if {![info exists selectedline]} {
- set findstartline [lindex [visiblerows] $rev]
+ set findstartline [lindex [visiblerows] [expr {$dirn < 0}]]
} else {
set findstartline $selectedline
}
set findcurline $findstartline
- nowbusy finding
- if {!$rev} {
- run findmore
- } else {
- if {$findcurline == 0} {
- set findcurline $numcommits
- }
- incr findcurline -1
- run findmorerev
+ nowbusy finding "Searching"
+ if {$gdttype ne "containing:" && ![info exists filehighlight]} {
+ after cancel do_file_hl $fh_serial
+ do_file_hl $fh_serial
}
+ set find_dirn $dirn
+ set findallowwrap $wrap
+ run findmore
}
-proc findnext {restart} {
- global findcurline
- if {![info exists findcurline]} {
- if {$restart} {
- dofind
- } else {
- bell
- }
- } else {
- run findmore
- nowbusy finding
- }
-}
+proc stopfinding {} {
+ global find_dirn findcurline fprogcoord
-proc findprev {} {
- global findcurline
- if {![info exists findcurline]} {
- dofind 1
- } else {
- run findmorerev
- nowbusy finding
+ if {[info exists find_dirn]} {
+ unset find_dirn
+ unset findcurline
+ notbusy finding
+ set fprogcoord 0
+ adjustprogress
}
}
proc findmore {} {
- global commitdata commitinfo numcommits findstring findpattern findloc
+ global commitdata commitinfo numcommits findpattern findloc
global findstartline findcurline displayorder
+ global find_dirn gdttype fhighlights fprogcoord
+ global findallowwrap
- set fldtypes {Headline Author Date Committer CDate Comments}
- set l [expr {$findcurline + 1}]
- if {$l >= $numcommits} {
- set l 0
- }
- if {$l <= $findstartline} {
- set lim [expr {$findstartline + 1}]
- } else {
- set lim $numcommits
- }
- if {$lim - $l > 500} {
- set lim [expr {$l + 500}]
- }
- set last 0
- for {} {$l < $lim} {incr l} {
- set id [lindex $displayorder $l]
- # shouldn't happen unless git log doesn't give all the commits...
- if {![info exists commitdata($id)]} continue
- if {![doesmatch $commitdata($id)]} continue
- if {![info exists commitinfo($id)]} {
- getcommit $id
- }
- set info $commitinfo($id)
- foreach f $info ty $fldtypes {
- if {($findloc eq "All fields" || $findloc eq $ty) &&
- [doesmatch $f]} {
- findselectline $l
- notbusy finding
- return 0
- }
- }
- }
- if {$l == $findstartline + 1} {
- bell
- unset findcurline
- notbusy finding
+ if {![info exists find_dirn]} {
return 0
}
- set findcurline [expr {$l - 1}]
- return 1
-}
-
-proc findmorerev {} {
- global commitdata commitinfo numcommits findstring findpattern findloc
- global findstartline findcurline displayorder
-
set fldtypes {Headline Author Date Committer CDate Comments}
set l $findcurline
- if {$l == 0} {
- set l $numcommits
- }
- incr l -1
- if {$l >= $findstartline} {
- set lim [expr {$findstartline - 1}]
+ set moretodo 0
+ if {$find_dirn > 0} {
+ incr l
+ if {$l >= $numcommits} {
+ set l 0
+ }
+ if {$l <= $findstartline} {
+ set lim [expr {$findstartline + 1}]
+ } else {
+ set lim $numcommits
+ set moretodo $findallowwrap
+ }
} else {
- set lim -1
- }
- if {$l - $lim > 500} {
- set lim [expr {$l - 500}]
- }
- set last 0
- for {} {$l > $lim} {incr l -1} {
- set id [lindex $displayorder $l]
- if {![doesmatch $commitdata($id)]} continue
- if {![info exists commitinfo($id)]} {
- getcommit $id
+ if {$l == 0} {
+ set l $numcommits
}
- set info $commitinfo($id)
- foreach f $info ty $fldtypes {
- if {($findloc eq "All fields" || $findloc eq $ty) &&
- [doesmatch $f]} {
- findselectline $l
- notbusy finding
- return 0
+ incr l -1
+ if {$l >= $findstartline} {
+ set lim [expr {$findstartline - 1}]
+ } else {
+ set lim -1
+ set moretodo $findallowwrap
+ }
+ }
+ set n [expr {($lim - $l) * $find_dirn}]
+ if {$n > 500} {
+ set n 500
+ set moretodo 1
+ }
+ set found 0
+ set domore 1
+ if {$gdttype eq "containing:"} {
+ for {} {$n > 0} {incr n -1; incr l $find_dirn} {
+ set id [lindex $displayorder $l]
+ # shouldn't happen unless git log doesn't give all the commits...
+ if {![info exists commitdata($id)]} continue
+ if {![doesmatch $commitdata($id)]} continue
+ if {![info exists commitinfo($id)]} {
+ getcommit $id
+ }
+ set info $commitinfo($id)
+ foreach f $info ty $fldtypes {
+ if {($findloc eq "All fields" || $findloc eq $ty) &&
+ [doesmatch $f]} {
+ set found 1
+ break
+ }
+ }
+ if {$found} break
+ }
+ } else {
+ for {} {$n > 0} {incr n -1; incr l $find_dirn} {
+ set id [lindex $displayorder $l]
+ if {![info exists fhighlights($l)]} {
+ askfilehighlight $l $id
+ if {$domore} {
+ set domore 0
+ set findcurline [expr {$l - $find_dirn}]
+ }
+ } elseif {$fhighlights($l)} {
+ set found $domore
+ break
}
}
}
- if {$l == -1} {
- bell
+ if {$found || ($domore && !$moretodo)} {
unset findcurline
+ unset find_dirn
notbusy finding
+ set fprogcoord 0
+ adjustprogress
+ if {$found} {
+ findselectline $l
+ } else {
+ bell
+ }
return 0
}
- set findcurline [expr {$l + 1}]
- return 1
+ if {!$domore} {
+ flushhighlights
+ } else {
+ set findcurline [expr {$l - $find_dirn}]
+ }
+ set n [expr {($findcurline - $findstartline) * $find_dirn - 1}]
+ if {$n < 0} {
+ incr n $numcommits
+ }
+ set fprogcoord [expr {$n * 1.0 / $numcommits}]
+ adjustprogress
+ return $domore
}
proc findselectline {l} {
- global findloc commentend ctext findcurline markingmatches
+ global findloc commentend ctext findcurline markingmatches gdttype
set markingmatches 1
set findcurline $l
}
proc unmarkmatches {} {
- global findids markingmatches findcurline
+ global markingmatches
allcanvs delete matches
- catch {unset findids}
set markingmatches 0
- catch {unset findcurline}
+ stopfinding
}
proc selcanvline {w x y} {
# append some text to the ctext widget, and make any SHA1 ID
# that we know about be a clickable link.
proc appendwithlinks {text tags} {
- global ctext commitrow linknum curview
+ global ctext commitrow linknum curview pendinglinks
set start [$ctext index "end - 1c"]
$ctext insert end $text $tags
set s [lindex $l 0]
set e [lindex $l 1]
set linkid [string range $text $s $e]
- if {![info exists commitrow($curview,$linkid)]} continue
incr e
- $ctext tag add link "$start + $s c" "$start + $e c"
+ $ctext tag delete link$linknum
$ctext tag add link$linknum "$start + $s c" "$start + $e c"
- $ctext tag bind link$linknum <1> \
- [list selectline $commitrow($curview,$linkid) 1]
+ setlink $linkid link$linknum
incr linknum
}
- $ctext tag conf link -foreground blue -underline 1
- $ctext tag bind link <Enter> { %W configure -cursor hand2 }
- $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
+}
+
+proc setlink {id lk} {
+ global curview commitrow ctext pendinglinks commitinterest
+
+ if {[info exists commitrow($curview,$id)]} {
+ $ctext tag conf $lk -foreground blue -underline 1
+ $ctext tag bind $lk <1> [list selectline $commitrow($curview,$id) 1]
+ $ctext tag bind $lk <Enter> {linkcursor %W 1}
+ $ctext tag bind $lk <Leave> {linkcursor %W -1}
+ } else {
+ lappend pendinglinks($id) $lk
+ lappend commitinterest($id) {makelink %I}
+ }
+}
+
+proc makelink {id} {
+ global pendinglinks
+
+ if {![info exists pendinglinks($id)]} return
+ foreach lk $pendinglinks($id) {
+ setlink $id $lk
+ }
+ unset pendinglinks($id)
+}
+
+proc linkcursor {w inc} {
+ global linkentercount curtextcursor
+
+ if {[incr linkentercount $inc] > 0} {
+ $w configure -cursor hand2
+ } else {
+ $w configure -cursor $curtextcursor
+ if {$linkentercount < 0} {
+ set linkentercount 0
+ }
+ }
}
proc viewnextline {dir} {
$ctext tag delete $lk
$ctext insert $pos $sep
$ctext insert $pos [lindex $ti 0] $lk
- if {[info exists commitrow($curview,$id)]} {
- $ctext tag conf $lk -foreground blue
- $ctext tag bind $lk <1> \
- [list selectline $commitrow($curview,$id) 1]
- $ctext tag conf $lk -underline 1
- $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
- $ctext tag bind $lk <Leave> \
- { %W configure -cursor $curtextcursor }
- }
+ setlink $id $lk
set sep ", "
}
}
}
}
+proc make_secsel {l} {
+ global linehtag linentag linedtag canv canv2 canv3
+
+ if {![info exists linehtag($l)]} return
+ $canv delete secsel
+ set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
+ -tags secsel -fill [$canv cget -selectbackground]]
+ $canv lower $t
+ $canv2 delete secsel
+ set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
+ -tags secsel -fill [$canv2 cget -selectbackground]]
+ $canv2 lower $t
+ $canv3 delete secsel
+ set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
+ -tags secsel -fill [$canv3 cget -selectbackground]]
+ $canv3 lower $t
+}
+
proc selectline {l isnew} {
- global canv canv2 canv3 ctext commitinfo selectedline
- global displayorder linehtag linentag linedtag
+ global canv ctext commitinfo selectedline
+ global displayorder
global canvy0 linespc parentlist children curview
global currentid sha1entry
global commentend idtags linknum
catch {unset pending_select}
$canv delete hover
normalline
- cancel_next_highlight
+ unsel_reflist
+ stopfinding
if {$l < 0 || $l >= $numcommits} return
set y [expr {$canvy0 + $l * $linespc}]
set ymax [lindex [$canv cget -scrollregion] 3]
if {$newtop < $wtop + $linespc} {
set newtop [expr {$wtop + $linespc}]
}
- }
- }
- if {$newtop != $wtop} {
- if {$newtop < 0} {
- set newtop 0
- }
- allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
- drawvisible
- }
-
- if {![info exists linehtag($l)]} return
- $canv delete secsel
- set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
- -tags secsel -fill [$canv cget -selectbackground]]
- $canv lower $t
- $canv2 delete secsel
- set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
- -tags secsel -fill [$canv2 cget -selectbackground]]
- $canv2 lower $t
- $canv3 delete secsel
- set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
- -tags secsel -fill [$canv3 cget -selectbackground]]
- $canv3 lower $t
+ }
+ }
+ if {$newtop != $wtop} {
+ if {$newtop < 0} {
+ set newtop 0
+ }
+ allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
+ drawvisible
+ }
+
+ make_secsel $l
if {$isnew} {
addtohistory [list selectline $l 0]
set linknum 0
set info $commitinfo($id)
set date [formatdate [lindex $info 2]]
- $ctext insert end "Author: [lindex $info 1] $date\n"
+ $ctext insert end "[mc "Author"]: [lindex $info 1] $date\n"
set date [formatdate [lindex $info 4]]
- $ctext insert end "Committer: [lindex $info 3] $date\n"
+ $ctext insert end "[mc "Committer"]: [lindex $info 3] $date\n"
if {[info exists idtags($id)]} {
- $ctext insert end "Tags:"
+ $ctext insert end [mc "Tags:"]
foreach tag $idtags($id) {
$ctext insert end " $tag"
}
} else {
set tag m$np
}
- $ctext insert end "Parent: " $tag
+ $ctext insert end "[mc "Parent"]: " $tag
appendwithlinks [commit_descriptor $p] {}
incr np
}
} else {
foreach p $olds {
- append headers "Parent: [commit_descriptor $p]"
+ append headers "[mc "Parent"]: [commit_descriptor $p]"
}
}
foreach c $children($curview,$id) {
- append headers "Child: [commit_descriptor $c]"
+ append headers "[mc "Child"]: [commit_descriptor $c]"
}
# make anything that looks like a SHA1 ID be a clickable link
if {![info exists allcommits]} {
getallcommits
}
- $ctext insert end "Branch: "
+ $ctext insert end "[mc "Branch"]: "
$ctext mark set branch "end -1c"
$ctext mark gravity branch left
- $ctext insert end "\nFollows: "
+ $ctext insert end "\n[mc "Follows"]: "
$ctext mark set follows "end -1c"
$ctext mark gravity follows left
- $ctext insert end "\nPrecedes: "
+ $ctext insert end "\n[mc "Precedes"]: "
$ctext mark set precedes "end -1c"
$ctext mark gravity precedes left
$ctext insert end "\n"
proc selnextline {dir} {
global selectedline
+ focus .
if {![info exists selectedline]} return
set l [expr {$selectedline + $dir}]
unmarkmatches
catch {unset currentid}
allcanvs delete secsel
rhighlight_none
- cancel_next_highlight
}
proc reselectline {} {
proc goback {} {
global history historyindex
+ focus .
if {$historyindex > 1} {
incr historyindex -1
proc goforw {} {
global history historyindex
+ focus .
if {$historyindex < [llength $history]} {
set cmd [lindex $history $historyindex]
$ctext insert end "$f\n" filesep
$ctext config -state disabled
$ctext yview $commentend
+ settabs 0
}
proc getblobline {bf id} {
}
proc mergediff {id l} {
- global diffmergeid diffopts mdifffd
+ global diffmergeid mdifffd
global diffids
global parentlist
+ global limitdiffs viewfiles curview
set diffmergeid $id
set diffids $id
# this doesn't seem to actually affect anything...
- set env(GIT_DIFF_OPTS) $diffopts
set cmd [concat | git diff-tree --no-commit-id --cc $id]
+ if {$limitdiffs && $viewfiles($curview) ne {}} {
+ set cmd [concat $cmd -- $viewfiles($curview)]
+ }
if {[catch {set mdf [open $cmd r]} err]} {
- error_popup "Error getting merge diffs: $err"
+ error_popup "[mc "Error getting merge diffs:"] $err"
return
}
fconfigure $mdf -blocking 0
set mdifffd($id) $mdf
set np [llength [lindex $parentlist $l]]
+ settabs $np
filerun $mdf [list getmergediffline $mdf $id $np]
}
proc startdiff {ids} {
global treediffs diffids treepending diffmergeid nullid nullid2
+ settabs 1
set diffids $ids
catch {unset diffmergeid}
if {![info exists treediffs($ids)] ||
}
}
+proc path_filter {filter name} {
+ foreach p $filter {
+ set l [string length $p]
+ if {[string index $p end] eq "/"} {
+ if {[string compare -length $l $p $name] == 0} {
+ return 1
+ }
+ } else {
+ if {[string compare -length $l $p $name] == 0 &&
+ ([string length $name] == $l ||
+ [string index $name $l] eq "/")} {
+ return 1
+ }
+ }
+ }
+ return 0
+}
+
proc addtocflist {ids} {
- global treediffs cflist
+ global treediffs
+
add_flist $treediffs($ids)
getblobdiffs $ids
}
proc gettreediffline {gdtf ids} {
global treediff treediffs treepending diffids diffmergeid
- global cmitmode
+ global cmitmode viewfiles curview limitdiffs
set nr 0
while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} {
return [expr {$nr >= 1000? 2: 1}]
}
close $gdtf
- set treediffs($ids) $treediff
+ if {$limitdiffs && $viewfiles($curview) ne {}} {
+ set flist {}
+ foreach f $treediff {
+ if {[path_filter $viewfiles($curview) $f]} {
+ lappend flist $f
+ }
+ }
+ set treediffs($ids) $flist
+ } else {
+ set treediffs($ids) $treediff
+ }
unset treepending
if {$cmitmode eq "tree"} {
gettree $diffids
return 0
}
+# empty string or positive integer
+proc diffcontextvalidate {v} {
+ return [regexp {^(|[1-9][0-9]*)$} $v]
+}
+
+proc diffcontextchange {n1 n2 op} {
+ global diffcontextstring diffcontext
+
+ if {[string is integer -strict $diffcontextstring]} {
+ if {$diffcontextstring > 0} {
+ set diffcontext $diffcontextstring
+ reselectline
+ }
+ }
+}
+
proc getblobdiffs {ids} {
- global diffopts blobdifffd diffids env
+ global blobdifffd diffids env
global diffinhdr treediffs
+ global diffcontext
+ global limitdiffs viewfiles curview
- set env(GIT_DIFF_OPTS) $diffopts
- if {[catch {set bdf [open [diffcmd $ids {-p -C --no-commit-id}] r]} err]} {
+ set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"]
+ if {$limitdiffs && $viewfiles($curview) ne {}} {
+ set cmd [concat $cmd -- $viewfiles($curview)]
+ }
+ if {[catch {set bdf [open $cmd r]} err]} {
puts "error getting diffs: $err"
return
}
# the middle char will be a space, and the two bits either
# side will be a/name and b/name, or "a/name" and "b/name".
# If the name has changed we'll get "rename from" and
- # "rename to" lines following this, and we'll use them
- # to get the filenames.
+ # "rename to" or "copy from" and "copy to" lines following this,
+ # and we'll use them to get the filenames.
# This complexity is necessary because spaces in the filename(s)
# don't get escaped.
set l [string length $line]
} elseif {$diffinhdr} {
if {![string compare -length 12 "rename from " $line]} {
- set fname [string range $line 12 end]
+ set fname [string range $line [expr 6 + [string first " from " $line] ] end]
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
if {$i >= 0} {
setinlist difffilestart $i $curdiffstart
}
- } elseif {![string compare -length 10 $line "rename to "]} {
- set fname [string range $line 10 end]
+ } elseif {![string compare -length 10 $line "rename to "] ||
+ ![string compare -length 8 $line "copy to "]} {
+ set fname [string range $line [expr 4 + [string first " to " $line] ] end]
if {[string index $fname 0] eq "\""} {
set fname [lindex $fname 0]
}
proc clear_ctext {{first 1.0}} {
global ctext smarktop smarkbot
+ global pendinglinks
set l [lindex [split $first .] 0]
if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
set smarkbot $l
}
$ctext delete $first end
+ if {$first eq "1.0"} {
+ catch {unset pendinglinks}
+ }
+}
+
+proc settabs {{firstab {}}} {
+ global firsttabstop tabstop ctext have_tk85
+
+ if {$firstab ne {} && $have_tk85} {
+ set firsttabstop $firstab
+ }
+ set w [font measure textfont "0"]
+ if {$firsttabstop != 0} {
+ $ctext conf -tabs [list [expr {($firsttabstop + $tabstop) * $w}] \
+ [expr {($firsttabstop + 2 * $tabstop) * $w}]]
+ } elseif {$have_tk85 || $tabstop != 8} {
+ $ctext conf -tabs [expr {$tabstop * $w}]
+ } else {
+ $ctext conf -tabs {}
+ }
}
proc incrsearch {name ix op} {
}
proc setcoords {} {
- global linespc charspc canvx0 canvy0 mainfont
+ global linespc charspc canvx0 canvy0
global xspc1 xspc2 lthickness
- set linespc [font metrics $mainfont -linespace]
- set charspc [font measure $mainfont "m"]
+ set linespc [font metrics mainfont -linespace]
+ set charspc [font measure mainfont "m"]
set canvy0 [expr {int(3 + 0.5 * $linespc)}]
set canvx0 [expr {int(3 + 0.5 * $linespc)}]
set lthickness [expr {int($linespc / 9) + 1}]
}
}
+proc parsefont {f n} {
+ global fontattr
+
+ set fontattr($f,family) [lindex $n 0]
+ set s [lindex $n 1]
+ if {$s eq {} || $s == 0} {
+ set s 10
+ } elseif {$s < 0} {
+ set s [expr {int(-$s / [winfo fpixels . 1p] + 0.5)}]
+ }
+ set fontattr($f,size) $s
+ set fontattr($f,weight) normal
+ set fontattr($f,slant) roman
+ foreach style [lrange $n 2 end] {
+ switch -- $style {
+ "normal" -
+ "bold" {set fontattr($f,weight) $style}
+ "roman" -
+ "italic" {set fontattr($f,slant) $style}
+ }
+ }
+}
+
+proc fontflags {f {isbold 0}} {
+ global fontattr
+
+ return [list -family $fontattr($f,family) -size $fontattr($f,size) \
+ -weight [expr {$isbold? "bold": $fontattr($f,weight)}] \
+ -slant $fontattr($f,slant)]
+}
+
+proc fontname {f} {
+ global fontattr
+
+ set n [list $fontattr($f,family) $fontattr($f,size)]
+ if {$fontattr($f,weight) eq "bold"} {
+ lappend n "bold"
+ }
+ if {$fontattr($f,slant) eq "italic"} {
+ lappend n "italic"
+ }
+ return $n
+}
+
proc incrfont {inc} {
- global mainfont textfont ctext canv phase cflist
- global charspc tabstop
- global stopped entries
+ global mainfont textfont ctext canv phase cflist showrefstop
+ global stopped entries fontattr
+
unmarkmatches
- set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
- set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
+ set s $fontattr(mainfont,size)
+ incr s $inc
+ if {$s < 1} {
+ set s 1
+ }
+ set fontattr(mainfont,size) $s
+ font config mainfont -size $s
+ font config mainfontbold -size $s
+ set mainfont [fontname mainfont]
+ set s $fontattr(textfont,size)
+ incr s $inc
+ if {$s < 1} {
+ set s 1
+ }
+ set fontattr(textfont,size) $s
+ font config textfont -size $s
+ font config textfontbold -size $s
+ set textfont [fontname textfont]
setcoords
- $ctext conf -font $textfont -tabs "[expr {$tabstop * $charspc}]"
- $cflist conf -font $textfont
- $ctext tag conf filesep -font [concat $textfont bold]
- foreach e $entries {
- $e conf -font $mainfont
- }
- if {$phase eq "getcommits"} {
- $canv itemconf textitems -font $mainfont
- }
+ settabs
redisplay
}
}
if {[$sha1but cget -state] == $state} return
if {$state == "normal"} {
- $sha1but conf -state normal -relief raised -text "Goto: "
+ $sha1but conf -state normal -relief raised -text "[mc "Goto:"] "
} else {
- $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
+ $sha1but conf -state disabled -relief flat -text "[mc "SHA1 ID:"] "
}
}
}
if {$matches ne {}} {
if {[llength $matches] > 1} {
- error_popup "Short SHA1 id $id is ambiguous"
+ error_popup [mc "Short SHA1 id %s is ambiguous" $id]
return
}
set id [lindex $matches 0]
return
}
if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
- set type "SHA1 id"
+ set msg [mc "SHA1 id %s is not known" $sha1string]
} else {
- set type "Tag/Head"
+ set msg [mc "Tag/Head %s is not known" $sha1string]
}
- error_popup "$type $sha1string is not known"
+ error_popup $msg
}
proc lineenter {x y id} {
proc linehover {} {
global hoverx hovery hoverid hovertimer
global canv linespc lthickness
- global commitinfo mainfont
+ global commitinfo
set text [lindex $commitinfo($hoverid) 0]
set ymax [lindex [$canv cget -scrollregion] 3]
set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
set x0 [expr {$x - 2 * $lthickness}]
set y0 [expr {$y - 2 * $lthickness}]
- set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
+ set x1 [expr {$x + [font measure mainfont $text] + 2 * $lthickness}]
set y1 [expr {$y + $linespc + 2 * $lthickness}]
set t [$canv create rectangle $x0 $y0 $x1 $y1 \
-fill \#ffff80 -outline black -width 1 -tags hover]
$canv raise $t
set t [$canv create text $x $y -anchor nw -text $text -tags hover \
- -font $mainfont]
+ -font mainfont]
$canv raise $t
}
}
proc lineclick {x y id isnew} {
- global ctext commitinfo children canv thickerline curview
+ global ctext commitinfo children canv thickerline curview commitrow
if {![info exists commitinfo($id)] && ![getcommit $id]} return
unmarkmatches
# fill the details pane with info about this line
$ctext conf -state normal
clear_ctext
- $ctext tag conf link -foreground blue -underline 1
- $ctext tag bind link <Enter> { %W configure -cursor hand2 }
- $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
- $ctext insert end "Parent:\t"
- $ctext insert end $id [list link link0]
- $ctext tag bind link0 <1> [list selbyid $id]
+ settabs 0
+ $ctext insert end "[mc "Parent"]:\t"
+ $ctext insert end $id link0
+ setlink $id link0
set info $commitinfo($id)
$ctext insert end "\n\t[lindex $info 0]\n"
- $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
+ $ctext insert end "\t[mc "Author"]:\t[lindex $info 1]\n"
set date [formatdate [lindex $info 2]]
- $ctext insert end "\tDate:\t$date\n"
+ $ctext insert end "\t[mc "Date"]:\t$date\n"
set kids $children($curview,$id)
if {$kids ne {}} {
- $ctext insert end "\nChildren:"
+ $ctext insert end "\n[mc "Children"]:"
set i 0
foreach child $kids {
incr i
if {![info exists commitinfo($child)] && ![getcommit $child]} continue
set info $commitinfo($child)
$ctext insert end "\n\t"
- $ctext insert end $child [list link link$i]
- $ctext tag bind link$i <1> [list selbyid $child]
+ $ctext insert end $child link$i
+ setlink $child link$i
$ctext insert end "\n\t[lindex $info 0]"
- $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
+ $ctext insert end "\n\t[mc "Author"]:\t[lindex $info 1]"
set date [formatdate [lindex $info 2]]
- $ctext insert end "\n\tDate:\t$date\n"
+ $ctext insert end "\n\t[mc "Date"]:\t$date\n"
}
}
$ctext conf -state disabled
global rowctxmenu commitrow selectedline rowmenuid curview
global nullid nullid2 fakerowmenu mainhead
+ stopfinding
set rowmenuid $id
if {![info exists selectedline]
|| $commitrow($curview,$id) eq $selectedline} {
}
if {$id ne $nullid && $id ne $nullid2} {
set menu $rowctxmenu
- $menu entryconfigure 7 -label "Reset $mainhead branch to here"
+ $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead]
} else {
set menu $fakerowmenu
}
- $menu entryconfigure "Diff this*" -state $state
- $menu entryconfigure "Diff selected*" -state $state
- $menu entryconfigure "Make patch" -state $state
+ $menu entryconfigure [mc "Diff this -> selected"] -state $state
+ $menu entryconfigure [mc "Diff selected -> this"] -state $state
+ $menu entryconfigure [mc "Make patch"] -state $state
tk_popup $menu $x $y
}
$ctext conf -state normal
clear_ctext
- init_flist "Top"
- $ctext insert end "From "
- $ctext tag conf link -foreground blue -underline 1
- $ctext tag bind link <Enter> { %W configure -cursor hand2 }
- $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
- $ctext tag bind link0 <1> [list selbyid $oldid]
- $ctext insert end $oldid [list link link0]
+ init_flist [mc "Top"]
+ $ctext insert end "[mc "From"] "
+ $ctext insert end $oldid link0
+ setlink $oldid link0
$ctext insert end "\n "
$ctext insert end [lindex $commitinfo($oldid) 0]
- $ctext insert end "\n\nTo "
- $ctext tag bind link1 <1> [list selbyid $newid]
- $ctext insert end $newid [list link link1]
+ $ctext insert end "\n\n[mc "To"] "
+ $ctext insert end $newid link1
+ setlink $newid link1
$ctext insert end "\n "
$ctext insert end [lindex $commitinfo($newid) 0]
$ctext insert end "\n"
set patchtop $top
catch {destroy $top}
toplevel $top
- label $top.title -text "Generate patch"
+ label $top.title -text [mc "Generate patch"]
grid $top.title - -pady 10
- label $top.from -text "From:"
+ label $top.from -text [mc "From:"]
entry $top.fromsha1 -width 40 -relief flat
$top.fromsha1 insert 0 $oldid
$top.fromsha1 conf -state readonly
$top.fromhead insert 0 $oldhead
$top.fromhead conf -state readonly
grid x $top.fromhead -sticky w
- label $top.to -text "To:"
+ label $top.to -text [mc "To:"]
entry $top.tosha1 -width 40 -relief flat
$top.tosha1 insert 0 $newid
$top.tosha1 conf -state readonly
$top.tohead insert 0 $newhead
$top.tohead conf -state readonly
grid x $top.tohead -sticky w
- button $top.rev -text "Reverse" -command mkpatchrev -padx 5
+ button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5
grid $top.rev x -pady 10
- label $top.flab -text "Output file:"
+ label $top.flab -text [mc "Output file:"]
entry $top.fname -width 60
$top.fname insert 0 [file normalize "patch$patchnum.patch"]
incr patchnum
grid $top.flab $top.fname -sticky w
frame $top.buts
- button $top.buts.gen -text "Generate" -command mkpatchgo
- button $top.buts.can -text "Cancel" -command mkpatchcan
+ button $top.buts.gen -text [mc "Generate"] -command mkpatchgo
+ button $top.buts.can -text [mc "Cancel"] -command mkpatchcan
grid $top.buts.gen $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set newid [$patchtop.tosha1 get]
set fname [$patchtop.fname get]
set cmd [diffcmd [list $oldid $newid] -p]
+ # trim off the initial "|"
+ set cmd [lrange $cmd 1 end]
lappend cmd >$fname &
if {[catch {eval exec $cmd} err]} {
- error_popup "Error creating patch: $err"
+ error_popup "[mc "Error creating patch:"] $err"
}
catch {destroy $patchtop}
unset patchtop
set mktagtop $top
catch {destroy $top}
toplevel $top
- label $top.title -text "Create tag"
+ label $top.title -text [mc "Create tag"]
grid $top.title - -pady 10
- label $top.id -text "ID:"
+ label $top.id -text [mc "ID:"]
entry $top.sha1 -width 40 -relief flat
$top.sha1 insert 0 $rowmenuid
$top.sha1 conf -state readonly
$top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
$top.head conf -state readonly
grid x $top.head -sticky w
- label $top.tlab -text "Tag name:"
+ label $top.tlab -text [mc "Tag name:"]
entry $top.tag -width 60
grid $top.tlab $top.tag -sticky w
frame $top.buts
- button $top.buts.gen -text "Create" -command mktaggo
- button $top.buts.can -text "Cancel" -command mktagcan
+ button $top.buts.gen -text [mc "Create"] -command mktaggo
+ button $top.buts.can -text [mc "Cancel"] -command mktagcan
grid $top.buts.gen $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set id [$mktagtop.sha1 get]
set tag [$mktagtop.tag get]
if {$tag == {}} {
- error_popup "No tag name specified"
+ error_popup [mc "No tag name specified"]
return
}
if {[info exists tagids($tag)]} {
- error_popup "Tag \"$tag\" already exists"
+ error_popup [mc "Tag \"%s\" already exists" $tag]
return
}
if {[catch {
puts $f $id
close $f
} err]} {
- error_popup "Error creating tag: $err"
+ error_popup "[mc "Error creating tag:"] $err"
return
}
lappend idtags($id) $tag
redrawtags $id
addedtag $id
+ dispneartags 0
+ run refill_reflist
}
proc redrawtags {id} {
global canv linehtag commitrow idpos selectedline curview
- global mainfont canvxmax iddrawn
+ global canvxmax iddrawn
if {![info exists commitrow($curview,$id)]} return
if {![info exists iddrawn($id)]} return
set xt [eval drawtags $id $idpos($id)]
$canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
- set xr [expr {$xt + [font measure $mainfont $text]}]
+ set xr [expr {$xt + [font measure mainfont $text]}]
if {$xr > $canvxmax} {
set canvxmax $xr
setcanvscroll
set wrcomtop $top
catch {destroy $top}
toplevel $top
- label $top.title -text "Write commit to file"
+ label $top.title -text [mc "Write commit to file"]
grid $top.title - -pady 10
- label $top.id -text "ID:"
+ label $top.id -text [mc "ID:"]
entry $top.sha1 -width 40 -relief flat
$top.sha1 insert 0 $rowmenuid
$top.sha1 conf -state readonly
$top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
$top.head conf -state readonly
grid x $top.head -sticky w
- label $top.clab -text "Command:"
+ label $top.clab -text [mc "Command:"]
entry $top.cmd -width 60 -textvariable wrcomcmd
grid $top.clab $top.cmd -sticky w -pady 10
- label $top.flab -text "Output file:"
+ label $top.flab -text [mc "Output file:"]
entry $top.fname -width 60
$top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
grid $top.flab $top.fname -sticky w
frame $top.buts
- button $top.buts.gen -text "Write" -command wrcomgo
- button $top.buts.can -text "Cancel" -command wrcomcan
+ button $top.buts.gen -text [mc "Write"] -command wrcomgo
+ button $top.buts.can -text [mc "Cancel"] -command wrcomcan
grid $top.buts.gen $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set cmd "echo $id | [$wrcomtop.cmd get]"
set fname [$wrcomtop.fname get]
if {[catch {exec sh -c $cmd >$fname &} err]} {
- error_popup "Error writing commit: $err"
+ error_popup "[mc "Error writing commit:"] $err"
}
catch {destroy $wrcomtop}
unset wrcomtop
set top .makebranch
catch {destroy $top}
toplevel $top
- label $top.title -text "Create new branch"
+ label $top.title -text [mc "Create new branch"]
grid $top.title - -pady 10
- label $top.id -text "ID:"
+ label $top.id -text [mc "ID:"]
entry $top.sha1 -width 40 -relief flat
$top.sha1 insert 0 $rowmenuid
$top.sha1 conf -state readonly
grid $top.id $top.sha1 -sticky w
- label $top.nlab -text "Name:"
+ label $top.nlab -text [mc "Name:"]
entry $top.name -width 40
grid $top.nlab $top.name -sticky w
frame $top.buts
- button $top.buts.go -text "Create" -command [list mkbrgo $top]
- button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
+ button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top]
+ button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}"
grid $top.buts.go $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
set name [$top.name get]
set id [$top.sha1 get]
if {$name eq {}} {
- error_popup "Please specify a name for the new branch"
+ error_popup [mc "Please specify a name for the new branch"]
return
}
catch {destroy $top}
notbusy newbranch
redrawtags $id
dispneartags 0
+ run refill_reflist
}
}
set oldhead [exec git rev-parse HEAD]
set dheads [descheads $rowmenuid]
if {$dheads ne {} && [lsearch -exact $dheads $oldhead] >= 0} {
- set ok [confirm_popup "Commit [string range $rowmenuid 0 7] is already\
- included in branch $mainhead -- really re-apply it?"]
+ set ok [confirm_popup [mc "Commit %s is already\
+ included in branch %s -- really re-apply it?" \
+ [string range $rowmenuid 0 7] $mainhead]]
if {!$ok} return
}
- nowbusy cherrypick
+ nowbusy cherrypick [mc "Cherry-picking"]
update
# Unfortunately git-cherry-pick writes stuff to stderr even when
# no error occurs, and exec takes that as an indication of error...
set newhead [exec git rev-parse HEAD]
if {$newhead eq $oldhead} {
notbusy cherrypick
- error_popup "No changes committed"
+ error_popup [mc "No changes committed"]
return
}
addnewchild $newhead $oldhead
proc resethead {} {
global mainheadid mainhead rowmenuid confirm_ok resettype
- global showlocalchanges
set confirm_ok 0
set w ".confirmreset"
toplevel $w
wm transient $w .
- wm title $w "Confirm reset"
+ wm title $w [mc "Confirm reset"]
message $w.m -text \
- "Reset branch $mainhead to [string range $rowmenuid 0 7]?" \
+ [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \
-justify center -aspect 1000
pack $w.m -side top -fill x -padx 20 -pady 20
frame $w.f -relief sunken -border 2
- message $w.f.rt -text "Reset type:" -aspect 1000
+ message $w.f.rt -text [mc "Reset type:"] -aspect 1000
grid $w.f.rt -sticky w
set resettype mixed
radiobutton $w.f.soft -value soft -variable resettype -justify left \
- -text "Soft: Leave working tree and index untouched"
+ -text [mc "Soft: Leave working tree and index untouched"]
grid $w.f.soft -sticky w
radiobutton $w.f.mixed -value mixed -variable resettype -justify left \
- -text "Mixed: Leave working tree untouched, reset index"
+ -text [mc "Mixed: Leave working tree untouched, reset index"]
grid $w.f.mixed -sticky w
radiobutton $w.f.hard -value hard -variable resettype -justify left \
- -text "Hard: Reset working tree and index\n(discard ALL local changes)"
+ -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"]
grid $w.f.hard -sticky w
pack $w.f -side top -fill x
- button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
+ button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
pack $w.ok -side left -fill x -padx 20 -pady 20
- button $w.cancel -text Cancel -command "destroy $w"
+ button $w.cancel -text [mc Cancel] -command "destroy $w"
pack $w.cancel -side right -fill x -padx 20 -pady 20
bind $w <Visibility> "grab $w; focus $w"
tkwait window $w
error_popup $err
} else {
dohidelocalchanges
- set w ".resetprogress"
- filerun $fd [list readresetstat $fd $w]
- toplevel $w
- wm transient $w
- wm title $w "Reset progress"
- message $w.m -text "Reset in progress, please wait..." \
- -justify center -aspect 1000
- pack $w.m -side top -fill x -padx 20 -pady 5
- canvas $w.c -width 150 -height 20 -bg white
- $w.c create rect 0 0 0 20 -fill green -tags rect
- pack $w.c -side top -fill x -padx 20 -pady 5 -expand 1
- nowbusy reset
+ filerun $fd [list readresetstat $fd]
+ nowbusy reset [mc "Resetting"]
}
}
-proc readresetstat {fd w} {
- global mainhead mainheadid showlocalchanges
+proc readresetstat {fd} {
+ global mainhead mainheadid showlocalchanges rprogcoord
if {[gets $fd line] >= 0} {
if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} {
- set x [expr {($m * 150) / $n}]
- $w.c coords rect 0 0 $x 20
+ set rprogcoord [expr {1.0 * $m / $n}]
+ adjustprogress
}
return 1
}
- destroy $w
+ set rprogcoord 0
+ adjustprogress
notbusy reset
if {[catch {close $fd} err]} {
error_popup $err
proc headmenu {x y id head} {
global headmenuid headmenuhead headctxmenu mainhead
+ stopfinding
set headmenuid $id
set headmenuhead $head
set state normal
# check the tree is clean first??
set oldmainhead $mainhead
- nowbusy checkout
+ nowbusy checkout [mc "Checking out"]
update
dohidelocalchanges
if {[catch {
proc rmbranch {} {
global headmenuid headmenuhead mainhead
- global headids idheads
+ global idheads
set head $headmenuhead
set id $headmenuid
# this check shouldn't be needed any more...
if {$head eq $mainhead} {
- error_popup "Cannot delete the currently checked-out branch"
+ error_popup [mc "Cannot delete the currently checked-out branch"]
return
}
set dheads [descheads $id]
- if {$dheads eq $headids($head)} {
+ if {[llength $dheads] == 1 && $idheads($dheads) eq $head} {
# the stuff on this branch isn't on any other branch
- if {![confirm_popup "The commits on branch $head aren't on any other\
- branch.\nReally delete branch $head?"]} return
+ if {![confirm_popup [mc "The commits on branch %s aren't on any other\
+ branch.\nReally delete branch %s?" $head $head]]} return
}
nowbusy rmbranch
update
redrawtags $id
notbusy rmbranch
dispneartags 0
+ run refill_reflist
}
-# Stuff for finding nearby tags
-proc getallcommits {} {
- global allcommits allids nbmp nextarc seeds
+# Display a list of tags and heads
+proc showrefs {} {
+ global showrefstop bgcolor fgcolor selectbgcolor
+ global bglist fglist reflistfilter reflist maincursor
- set allids {}
- set nbmp 0
- set nextarc 0
- set allcommits 0
- set seeds {}
- regetallcommits
+ set top .showrefs
+ set showrefstop $top
+ if {[winfo exists $top]} {
+ raise $top
+ refill_reflist
+ return
+ }
+ toplevel $top
+ wm title $top [mc "Tags and heads: %s" [file tail [pwd]]]
+ text $top.list -background $bgcolor -foreground $fgcolor \
+ -selectbackground $selectbgcolor -font mainfont \
+ -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
+ -width 30 -height 20 -cursor $maincursor \
+ -spacing1 1 -spacing3 1 -state disabled
+ $top.list tag configure highlight -background $selectbgcolor
+ lappend bglist $top.list
+ lappend fglist $top.list
+ scrollbar $top.ysb -command "$top.list yview" -orient vertical
+ scrollbar $top.xsb -command "$top.list xview" -orient horizontal
+ grid $top.list $top.ysb -sticky nsew
+ grid $top.xsb x -sticky ew
+ frame $top.f
+ label $top.f.l -text "[mc "Filter"]: " -font uifont
+ entry $top.f.e -width 20 -textvariable reflistfilter -font uifont
+ set reflistfilter "*"
+ trace add variable reflistfilter write reflistfilter_change
+ pack $top.f.e -side right -fill x -expand 1
+ pack $top.f.l -side left
+ grid $top.f - -sticky ew -pady 2
+ button $top.close -command [list destroy $top] -text [mc "Close"] \
+ -font uifont
+ grid $top.close -
+ grid columnconfigure $top 0 -weight 1
+ grid rowconfigure $top 0 -weight 1
+ bind $top.list <1> {break}
+ bind $top.list <B1-Motion> {break}
+ bind $top.list <ButtonRelease-1> {sel_reflist %W %x %y; break}
+ set reflist {}
+ refill_reflist
+}
+
+proc sel_reflist {w x y} {
+ global showrefstop reflist headids tagids otherrefids
+
+ if {![winfo exists $showrefstop]} return
+ set l [lindex [split [$w index "@$x,$y"] "."] 0]
+ set ref [lindex $reflist [expr {$l-1}]]
+ set n [lindex $ref 0]
+ switch -- [lindex $ref 1] {
+ "H" {selbyid $headids($n)}
+ "T" {selbyid $tagids($n)}
+ "o" {selbyid $otherrefids($n)}
+ }
+ $showrefstop.list tag add highlight $l.0 "$l.0 lineend"
+}
+
+proc unsel_reflist {} {
+ global showrefstop
+
+ if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
+ $showrefstop.list tag remove highlight 0.0 end
}
-# Called when the graph might have changed
-proc regetallcommits {} {
- global allcommits seeds
+proc reflistfilter_change {n1 n2 op} {
+ global reflistfilter
- set cmd [concat | git rev-list --all --parents]
- foreach id $seeds {
- lappend cmd "^$id"
+ after cancel refill_reflist
+ after 200 refill_reflist
+}
+
+proc refill_reflist {} {
+ global reflist reflistfilter showrefstop headids tagids otherrefids
+ global commitrow curview commitinterest
+
+ if {![info exists showrefstop] || ![winfo exists $showrefstop]} return
+ set refs {}
+ foreach n [array names headids] {
+ if {[string match $reflistfilter $n]} {
+ if {[info exists commitrow($curview,$headids($n))]} {
+ lappend refs [list $n H]
+ } else {
+ set commitinterest($headids($n)) {run refill_reflist}
+ }
+ }
+ }
+ foreach n [array names tagids] {
+ if {[string match $reflistfilter $n]} {
+ if {[info exists commitrow($curview,$tagids($n))]} {
+ lappend refs [list $n T]
+ } else {
+ set commitinterest($tagids($n)) {run refill_reflist}
+ }
+ }
+ }
+ foreach n [array names otherrefids] {
+ if {[string match $reflistfilter $n]} {
+ if {[info exists commitrow($curview,$otherrefids($n))]} {
+ lappend refs [list $n o]
+ } else {
+ set commitinterest($otherrefids($n)) {run refill_reflist}
+ }
+ }
+ }
+ set refs [lsort -index 0 $refs]
+ if {$refs eq $reflist} return
+
+ # Update the contents of $showrefstop.list according to the
+ # differences between $reflist (old) and $refs (new)
+ $showrefstop.list conf -state normal
+ $showrefstop.list insert end "\n"
+ set i 0
+ set j 0
+ while {$i < [llength $reflist] || $j < [llength $refs]} {
+ if {$i < [llength $reflist]} {
+ if {$j < [llength $refs]} {
+ set cmp [string compare [lindex $reflist $i 0] \
+ [lindex $refs $j 0]]
+ if {$cmp == 0} {
+ set cmp [string compare [lindex $reflist $i 1] \
+ [lindex $refs $j 1]]
+ }
+ } else {
+ set cmp -1
+ }
+ } else {
+ set cmp 1
+ }
+ switch -- $cmp {
+ -1 {
+ $showrefstop.list delete "[expr {$j+1}].0" "[expr {$j+2}].0"
+ incr i
+ }
+ 0 {
+ incr i
+ incr j
+ }
+ 1 {
+ set l [expr {$j + 1}]
+ $showrefstop.list image create $l.0 -align baseline \
+ -image reficon-[lindex $refs $j 1] -padx 2
+ $showrefstop.list insert $l.1 "[lindex $refs $j 0]\n"
+ incr j
+ }
+ }
+ }
+ set reflist $refs
+ # delete last newline
+ $showrefstop.list delete end-2c end-1c
+ $showrefstop.list conf -state disabled
+}
+
+# Stuff for finding nearby tags
+proc getallcommits {} {
+ global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate
+ global idheads idtags idotherrefs allparents tagobjid
+
+ if {![info exists allcommits]} {
+ set nextarc 0
+ set allcommits 0
+ set seeds {}
+ set allcwait 0
+ set cachedarcs 0
+ set allccache [file join [gitdir] "gitk.cache"]
+ if {![catch {
+ set f [open $allccache r]
+ set allcwait 1
+ getcache $f
+ }]} return
+ }
+
+ if {$allcwait} {
+ return
+ }
+ set cmd [list | git rev-list --parents]
+ set allcupdate [expr {$seeds ne {}}]
+ if {!$allcupdate} {
+ set ids "--all"
+ } else {
+ set refs [concat [array names idheads] [array names idtags] \
+ [array names idotherrefs]]
+ set ids {}
+ set tagobjs {}
+ foreach name [array names tagobjid] {
+ lappend tagobjs $tagobjid($name)
+ }
+ foreach id [lsort -unique $refs] {
+ if {![info exists allparents($id)] &&
+ [lsearch -exact $tagobjs $id] < 0} {
+ lappend ids $id
+ }
+ }
+ if {$ids ne {}} {
+ foreach id $seeds {
+ lappend ids "^$id"
+ }
+ }
+ }
+ if {$ids ne {}} {
+ set fd [open [concat $cmd $ids] r]
+ fconfigure $fd -blocking 0
+ incr allcommits
+ nowbusy allcommits
+ filerun $fd [list getallclines $fd]
+ } else {
+ dispneartags 0
}
- set fd [open $cmd r]
- fconfigure $fd -blocking 0
- incr allcommits
- nowbusy allcommits
- filerun $fd [list getallclines $fd]
}
# Since most commits have 1 parent and 1 child, we group strings of
# coming from descendents, and "outgoing" means going towards ancestors.
proc getallclines {fd} {
- global allids allparents allchildren idtags idheads nextarc nbmp
+ global allparents allchildren idtags idheads nextarc
global arcnos arcids arctags arcout arcend arcstart archeads growing
- global seeds allcommits
-
+ global seeds allcommits cachedarcs allcupdate
+
set nid 0
while {[incr nid] <= 1000 && [gets $fd line] >= 0} {
set id [lindex $line 0]
# seen it already
continue
}
- lappend allids $id
+ set cachedarcs 0
set olds [lrange $line 1 end]
set allparents($id) $olds
if {![info exists allchildren($id)]} {
continue
}
}
- incr nbmp
foreach a $arcnos($id) {
lappend arcids($a) $id
set arcend($a) $id
if {![eof $fd]} {
return [expr {$nid >= 1000? 2: 1}]
}
- close $fd
+ set cacheok 1
+ if {[catch {
+ fconfigure $fd -blocking 1
+ close $fd
+ } err]} {
+ # got an error reading the list of commits
+ # if we were updating, try rereading the whole thing again
+ if {$allcupdate} {
+ incr allcommits -1
+ dropcache $err
+ return
+ }
+ error_popup "[mc "Error reading commit topology information;\
+ branch and preceding/following tag information\
+ will be incomplete."]\n($err)"
+ set cacheok 0
+ }
if {[incr allcommits -1] == 0} {
notbusy allcommits
+ if {$cacheok} {
+ run savecache
+ }
}
dispneartags 0
return 0
}
proc splitarc {p} {
- global arcnos arcids nextarc nbmp arctags archeads idtags idheads
+ global arcnos arcids nextarc arctags archeads idtags idheads
global arcstart arcend arcout allparents growing
set a $arcnos($p)
set growing($na) 1
unset growing($a)
}
- incr nbmp
foreach id $tail {
if {[llength $arcnos($id)] == 1} {
# Update things for a new commit added that is a child of one
# existing commit. Used when cherry-picking.
proc addnewchild {id p} {
- global allids allparents allchildren idtags nextarc nbmp
+ global allparents allchildren idtags nextarc
global arcnos arcids arctags arcout arcend arcstart archeads growing
- global seeds
+ global seeds allcommits
- lappend allids $id
+ if {![info exists allcommits] || ![info exists arcnos($p)]} return
set allparents($id) [list $p]
set allchildren($id) {}
set arcnos($id) {}
lappend seeds $id
- incr nbmp
lappend allchildren($p) $id
set a [incr nextarc]
set arcstart($a) $id
set arcout($id) [list $a]
}
+# This implements a cache for the topology information.
+# The cache saves, for each arc, the start and end of the arc,
+# the ids on the arc, and the outgoing arcs from the end.
+proc readcache {f} {
+ global arcnos arcids arcout arcstart arcend arctags archeads nextarc
+ global idtags idheads allparents cachedarcs possible_seeds seeds growing
+ global allcwait
+
+ set a $nextarc
+ set lim $cachedarcs
+ if {$lim - $a > 500} {
+ set lim [expr {$a + 500}]
+ }
+ if {[catch {
+ if {$a == $lim} {
+ # finish reading the cache and setting up arctags, etc.
+ set line [gets $f]
+ if {$line ne "1"} {error "bad final version"}
+ close $f
+ foreach id [array names idtags] {
+ if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
+ [llength $allparents($id)] == 1} {
+ set a [lindex $arcnos($id) 0]
+ if {$arctags($a) eq {}} {
+ recalcarc $a
+ }
+ }
+ }
+ foreach id [array names idheads] {
+ if {[info exists arcnos($id)] && [llength $arcnos($id)] == 1 &&
+ [llength $allparents($id)] == 1} {
+ set a [lindex $arcnos($id) 0]
+ if {$archeads($a) eq {}} {
+ recalcarc $a
+ }
+ }
+ }
+ foreach id [lsort -unique $possible_seeds] {
+ if {$arcnos($id) eq {}} {
+ lappend seeds $id
+ }
+ }
+ set allcwait 0
+ } else {
+ while {[incr a] <= $lim} {
+ set line [gets $f]
+ if {[llength $line] != 3} {error "bad line"}
+ set s [lindex $line 0]
+ set arcstart($a) $s
+ lappend arcout($s) $a
+ if {![info exists arcnos($s)]} {
+ lappend possible_seeds $s
+ set arcnos($s) {}
+ }
+ set e [lindex $line 1]
+ if {$e eq {}} {
+ set growing($a) 1
+ } else {
+ set arcend($a) $e
+ if {![info exists arcout($e)]} {
+ set arcout($e) {}
+ }
+ }
+ set arcids($a) [lindex $line 2]
+ foreach id $arcids($a) {
+ lappend allparents($s) $id
+ set s $id
+ lappend arcnos($id) $a
+ }
+ if {![info exists allparents($s)]} {
+ set allparents($s) {}
+ }
+ set arctags($a) {}
+ set archeads($a) {}
+ }
+ set nextarc [expr {$a - 1}]
+ }
+ } err]} {
+ dropcache $err
+ return 0
+ }
+ if {!$allcwait} {
+ getallcommits
+ }
+ return $allcwait
+}
+
+proc getcache {f} {
+ global nextarc cachedarcs possible_seeds
+
+ if {[catch {
+ set line [gets $f]
+ if {[llength $line] != 2 || [lindex $line 0] ne "1"} {error "bad version"}
+ # make sure it's an integer
+ set cachedarcs [expr {int([lindex $line 1])}]
+ if {$cachedarcs < 0} {error "bad number of arcs"}
+ set nextarc 0
+ set possible_seeds {}
+ run readcache $f
+ } err]} {
+ dropcache $err
+ }
+ return 0
+}
+
+proc dropcache {err} {
+ global allcwait nextarc cachedarcs seeds
+
+ #puts "dropping cache ($err)"
+ foreach v {arcnos arcout arcids arcstart arcend growing \
+ arctags archeads allparents allchildren} {
+ global $v
+ catch {unset $v}
+ }
+ set allcwait 0
+ set nextarc 0
+ set cachedarcs 0
+ set seeds {}
+ getallcommits
+}
+
+proc writecache {f} {
+ global cachearc cachedarcs allccache
+ global arcstart arcend arcnos arcids arcout
+
+ set a $cachearc
+ set lim $cachedarcs
+ if {$lim - $a > 1000} {
+ set lim [expr {$a + 1000}]
+ }
+ if {[catch {
+ while {[incr a] <= $lim} {
+ if {[info exists arcend($a)]} {
+ puts $f [list $arcstart($a) $arcend($a) $arcids($a)]
+ } else {
+ puts $f [list $arcstart($a) {} $arcids($a)]
+ }
+ }
+ } err]} {
+ catch {close $f}
+ catch {file delete $allccache}
+ #puts "writing cache failed ($err)"
+ return 0
+ }
+ set cachearc [expr {$a - 1}]
+ if {$a > $cachedarcs} {
+ puts $f "1"
+ close $f
+ return 0
+ }
+ return 1
+}
+
+proc savecache {} {
+ global nextarc cachedarcs cachearc allccache
+
+ if {$nextarc == $cachedarcs} return
+ set cachearc 0
+ set cachedarcs $nextarc
+ catch {
+ set f [open $allccache w]
+ puts $f [list 1 $cachedarcs]
+ run writecache $f
+ }
+}
+
# Returns 1 if a is an ancestor of b, -1 if b is an ancestor of a,
# or 0 if neither is true.
proc anc_or_desc {a b} {
redrawtags $id
}
}
+ run refill_reflist
}
proc listrefs {id} {
}
$ctext conf -state normal
clear_ctext
+ settabs 0
set linknum 0
if {![info exists tagcontents($tag)]} {
catch {
if {[info exists tagcontents($tag)]} {
set text $tagcontents($tag)
} else {
- set text "Tag: $tag\nId: $tagids($tag)"
+ set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)"
}
appendwithlinks $text {}
$ctext conf -state disabled
destroy .
}
+proc mkfontdisp {font top which} {
+ global fontattr fontpref $font
+
+ set fontpref($font) [set $font]
+ button $top.${font}but -text $which -font optionfont \
+ -command [list choosefont $font $which]
+ label $top.$font -relief flat -font $font \
+ -text $fontattr($font,family) -justify left
+ grid x $top.${font}but $top.$font -sticky w
+}
+
+proc choosefont {font which} {
+ global fontparam fontlist fonttop fontattr
+
+ set fontparam(which) $which
+ set fontparam(font) $font
+ set fontparam(family) [font actual $font -family]
+ set fontparam(size) $fontattr($font,size)
+ set fontparam(weight) $fontattr($font,weight)
+ set fontparam(slant) $fontattr($font,slant)
+ set top .gitkfont
+ set fonttop $top
+ if {![winfo exists $top]} {
+ font create sample
+ eval font config sample [font actual $font]
+ toplevel $top
+ wm title $top [mc "Gitk font chooser"]
+ label $top.l -textvariable fontparam(which) -font uifont
+ pack $top.l -side top
+ set fontlist [lsort [font families]]
+ frame $top.f
+ listbox $top.f.fam -listvariable fontlist \
+ -yscrollcommand [list $top.f.sb set]
+ bind $top.f.fam <<ListboxSelect>> selfontfam
+ scrollbar $top.f.sb -command [list $top.f.fam yview]
+ pack $top.f.sb -side right -fill y
+ pack $top.f.fam -side left -fill both -expand 1
+ pack $top.f -side top -fill both -expand 1
+ frame $top.g
+ spinbox $top.g.size -from 4 -to 40 -width 4 \
+ -textvariable fontparam(size) \
+ -validatecommand {string is integer -strict %s}
+ checkbutton $top.g.bold -padx 5 \
+ -font {{Times New Roman} 12 bold} -text [mc "B"] -indicatoron 0 \
+ -variable fontparam(weight) -onvalue bold -offvalue normal
+ checkbutton $top.g.ital -padx 5 \
+ -font {{Times New Roman} 12 italic} -text [mc "I"] -indicatoron 0 \
+ -variable fontparam(slant) -onvalue italic -offvalue roman
+ pack $top.g.size $top.g.bold $top.g.ital -side left
+ pack $top.g -side top
+ canvas $top.c -width 150 -height 50 -border 2 -relief sunk \
+ -background white
+ $top.c create text 100 25 -anchor center -text $which -font sample \
+ -fill black -tags text
+ bind $top.c <Configure> [list centertext $top.c]
+ pack $top.c -side top -fill x
+ frame $top.buts
+ button $top.buts.ok -text [mc "OK"] -command fontok -default active \
+ -font uifont
+ button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal \
+ -font uifont
+ grid $top.buts.ok $top.buts.can
+ grid columnconfigure $top.buts 0 -weight 1 -uniform a
+ grid columnconfigure $top.buts 1 -weight 1 -uniform a
+ pack $top.buts -side bottom -fill x
+ trace add variable fontparam write chg_fontparam
+ } else {
+ raise $top
+ $top.c itemconf text -text $which
+ }
+ set i [lsearch -exact $fontlist $fontparam(family)]
+ if {$i >= 0} {
+ $top.f.fam selection set $i
+ $top.f.fam see $i
+ }
+}
+
+proc centertext {w} {
+ $w coords text [expr {[winfo width $w] / 2}] [expr {[winfo height $w] / 2}]
+}
+
+proc fontok {} {
+ global fontparam fontpref prefstop
+
+ set f $fontparam(font)
+ set fontpref($f) [list $fontparam(family) $fontparam(size)]
+ if {$fontparam(weight) eq "bold"} {
+ lappend fontpref($f) "bold"
+ }
+ if {$fontparam(slant) eq "italic"} {
+ lappend fontpref($f) "italic"
+ }
+ set w $prefstop.$f
+ $w conf -text $fontparam(family) -font $fontpref($f)
+
+ fontcan
+}
+
+proc fontcan {} {
+ global fonttop fontparam
+
+ if {[info exists fonttop]} {
+ catch {destroy $fonttop}
+ catch {font delete sample}
+ unset fonttop
+ unset fontparam
+ }
+}
+
+proc selfontfam {} {
+ global fonttop fontparam
+
+ set i [$fonttop.f.fam curselection]
+ if {$i ne {}} {
+ set fontparam(family) [$fonttop.f.fam get $i]
+ }
+}
+
+proc chg_fontparam {v sub op} {
+ global fontparam
+
+ font config sample -$sub $fontparam($sub)
+}
+
proc doprefs {} {
- global maxwidth maxgraphpct diffopts
+ global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
global bgcolor fgcolor ctext diffcolors selectbgcolor
- global uifont tabstop
+ global uifont tabstop limitdiffs
set top .gitkprefs
set prefstop $top
raise $top
return
}
- foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
+ foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
+ limitdiffs tabstop} {
set oldprefs($v) [set $v]
}
toplevel $top
- wm title $top "Gitk preferences"
- label $top.ldisp -text "Commit list display options"
- $top.ldisp configure -font $uifont
+ wm title $top [mc "Gitk preferences"]
+ label $top.ldisp -text [mc "Commit list display options"]
+ $top.ldisp configure -font uifont
grid $top.ldisp - -sticky w -pady 10
label $top.spacer -text " "
- label $top.maxwidthl -text "Maximum graph width (lines)" \
+ label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \
-font optionfont
spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
- label $top.maxpctl -text "Maximum graph width (% of pane)" \
+ label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \
-font optionfont
spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
grid x $top.maxpctl $top.maxpct -sticky w
frame $top.showlocal
- label $top.showlocal.l -text "Show local changes" -font optionfont
+ label $top.showlocal.l -text [mc "Show local changes"] -font optionfont
checkbutton $top.showlocal.b -variable showlocalchanges
pack $top.showlocal.b $top.showlocal.l -side left
grid x $top.showlocal -sticky w
- label $top.ddisp -text "Diff display options"
- $top.ddisp configure -font $uifont
+ label $top.ddisp -text [mc "Diff display options"]
+ $top.ddisp configure -font uifont
grid $top.ddisp - -sticky w -pady 10
- label $top.diffoptl -text "Options for diff program" \
- -font optionfont
- entry $top.diffopt -width 20 -textvariable diffopts
- grid x $top.diffoptl $top.diffopt -sticky w
+ label $top.tabstopl -text [mc "Tab spacing"] -font optionfont
+ spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
+ grid x $top.tabstopl $top.tabstop -sticky w
frame $top.ntag
- label $top.ntag.l -text "Display nearby tags" -font optionfont
+ label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont
checkbutton $top.ntag.b -variable showneartags
pack $top.ntag.b $top.ntag.l -side left
grid x $top.ntag -sticky w
- label $top.tabstopl -text "tabstop" -font optionfont
- spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop
- grid x $top.tabstopl $top.tabstop -sticky w
-
- label $top.cdisp -text "Colors: press to choose"
- $top.cdisp configure -font $uifont
+ frame $top.ldiff
+ label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont
+ checkbutton $top.ldiff.b -variable limitdiffs
+ pack $top.ldiff.b $top.ldiff.l -side left
+ grid x $top.ldiff -sticky w
+
+ label $top.cdisp -text [mc "Colors: press to choose"]
+ $top.cdisp configure -font uifont
grid $top.cdisp - -sticky w -pady 10
label $top.bg -padx 40 -relief sunk -background $bgcolor
- button $top.bgbut -text "Background" -font optionfont \
+ button $top.bgbut -text [mc "Background"] -font optionfont \
-command [list choosecolor bgcolor 0 $top.bg background setbg]
grid x $top.bgbut $top.bg -sticky w
label $top.fg -padx 40 -relief sunk -background $fgcolor
- button $top.fgbut -text "Foreground" -font optionfont \
+ button $top.fgbut -text [mc "Foreground"] -font optionfont \
-command [list choosecolor fgcolor 0 $top.fg foreground setfg]
grid x $top.fgbut $top.fg -sticky w
label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
- button $top.diffoldbut -text "Diff: old lines" -font optionfont \
+ button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \
-command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
[list $ctext tag conf d0 -foreground]]
grid x $top.diffoldbut $top.diffold -sticky w
label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
- button $top.diffnewbut -text "Diff: new lines" -font optionfont \
+ button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \
-command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
[list $ctext tag conf d1 -foreground]]
grid x $top.diffnewbut $top.diffnew -sticky w
label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
- button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
+ button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \
-command [list choosecolor diffcolors 2 $top.hunksep \
"diff hunk header" \
[list $ctext tag conf hunksep -foreground]]
grid x $top.hunksepbut $top.hunksep -sticky w
label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor
- button $top.selbgbut -text "Select bg" -font optionfont \
+ button $top.selbgbut -text [mc "Select bg"] -font optionfont \
-command [list choosecolor selectbgcolor 0 $top.selbgsep background setselbg]
grid x $top.selbgbut $top.selbgsep -sticky w
+ label $top.cfont -text [mc "Fonts: press to choose"]
+ $top.cfont configure -font uifont
+ grid $top.cfont - -sticky w -pady 10
+ mkfontdisp mainfont $top [mc "Main font"]
+ mkfontdisp textfont $top [mc "Diff display font"]
+ mkfontdisp uifont $top [mc "User interface font"]
+
frame $top.buts
- button $top.buts.ok -text "OK" -command prefsok -default active
- $top.buts.ok configure -font $uifont
- button $top.buts.can -text "Cancel" -command prefscan -default normal
- $top.buts.can configure -font $uifont
+ button $top.buts.ok -text [mc "OK"] -command prefsok -default active
+ $top.buts.ok configure -font uifont
+ button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal
+ $top.buts.can configure -font uifont
grid $top.buts.ok $top.buts.can
grid columnconfigure $top.buts 0 -weight 1 -uniform a
grid columnconfigure $top.buts 1 -weight 1 -uniform a
global $v
set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
- -title "Gitk: choose color for $x"]
+ -title [mc "Gitk: choose color for %s" $x]]
if {$c eq {}} return
$w conf -background $c
lset $v $vi $c
}
proc prefscan {} {
- global maxwidth maxgraphpct diffopts
- global oldprefs prefstop showneartags showlocalchanges
+ global oldprefs prefstop
- foreach v {maxwidth maxgraphpct diffopts showneartags showlocalchanges} {
+ foreach v {maxwidth maxgraphpct showneartags showlocalchanges \
+ limitdiffs tabstop} {
+ global $v
set $v $oldprefs($v)
}
catch {destroy $prefstop}
unset prefstop
+ fontcan
}
proc prefsok {} {
global maxwidth maxgraphpct
global oldprefs prefstop showneartags showlocalchanges
- global charspc ctext tabstop
+ global fontpref mainfont textfont uifont
+ global limitdiffs treediffs
catch {destroy $prefstop}
unset prefstop
- $ctext configure -tabs "[expr {$tabstop * $charspc}]"
+ fontcan
+ set fontchanged 0
+ if {$mainfont ne $fontpref(mainfont)} {
+ set mainfont $fontpref(mainfont)
+ parsefont mainfont $mainfont
+ eval font configure mainfont [fontflags mainfont]
+ eval font configure mainfontbold [fontflags mainfont 1]
+ setcoords
+ set fontchanged 1
+ }
+ if {$textfont ne $fontpref(textfont)} {
+ set textfont $fontpref(textfont)
+ parsefont textfont $textfont
+ eval font configure textfont [fontflags textfont]
+ eval font configure textfontbold [fontflags textfont 1]
+ }
+ if {$uifont ne $fontpref(uifont)} {
+ set uifont $fontpref(uifont)
+ parsefont uifont $uifont
+ eval font configure uifont [fontflags uifont]
+ }
+ settabs
if {$showlocalchanges != $oldprefs(showlocalchanges)} {
if {$showlocalchanges} {
doshowlocalchanges
dohidelocalchanges
}
}
- if {$maxwidth != $oldprefs(maxwidth)
+ if {$limitdiffs != $oldprefs(limitdiffs)} {
+ # treediffs elements are limited by path
+ catch {unset treediffs}
+ }
+ if {$fontchanged || $maxwidth != $oldprefs(maxwidth)
|| $maxgraphpct != $oldprefs(maxgraphpct)} {
redisplay
- } elseif {$showneartags != $oldprefs(showneartags)} {
+ } elseif {$showneartags != $oldprefs(showneartags) ||
+ $limitdiffs != $oldprefs(limitdiffs)} {
reselectline
}
}
proc formatdate {d} {
+ global datetimeformat
if {$d ne {}} {
- set d [clock format $d -format "%Y-%m-%d %H:%M:%S"]
+ set d [clock format $d -format $datetimeformat]
}
return $d
}
return {}
}
+# First check that Tcl/Tk is recent enough
+if {[catch {package require Tk 8.4} err]} {
+ show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\
+ Gitk requires at least Tcl/Tk 8.4."]
+ exit 1
+}
+
# defaults...
set datemode 0
-set diffopts "-U 5 -p"
set wrcomcmd "git diff-tree --stdin -p --pretty"
set gitencoding {}
set maxrefs 20
set maxlinelen 200
set showlocalchanges 1
+set limitdiffs 1
+set datetimeformat "%Y-%m-%d %H:%M:%S"
set colors {green red blue magenta darkgrey brown orange}
set bgcolor white
set fgcolor black
set diffcolors {red "#00a000" blue}
+set diffcontext 3
set selectbgcolor gray85
+## For msgcat loading, first locate the installation location.
+if { [info exists ::env(GITK_MSGSDIR)] } {
+ ## Msgsdir was manually set in the environment.
+ set gitk_msgsdir $::env(GITK_MSGSDIR)
+} else {
+ ## Let's guess the prefix from argv0.
+ set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
+ set gitk_libdir [file join $gitk_prefix share gitk lib]
+ set gitk_msgsdir [file join $gitk_libdir msgs]
+ unset gitk_prefix
+}
+
+## Internationalization (i18n) through msgcat and gettext. See
+## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
+package require msgcat
+namespace import ::msgcat::mc
+## And eventually load the actual message catalog
+::msgcat::mcload $gitk_msgsdir
+
catch {source ~/.gitk}
font create optionfont -family sans-serif -size -12
+parsefont mainfont $mainfont
+eval font create mainfont [fontflags mainfont]
+eval font create mainfontbold [fontflags mainfont 1]
+
+parsefont textfont $textfont
+eval font create textfont [fontflags textfont]
+eval font create textfontbold [fontflags textfont 1]
+
+parsefont uifont $uifont
+eval font create uifont [fontflags uifont]
+
# check that we can find a .git directory somewhere...
-set gitdir [gitdir]
+if {[catch {set gitdir [gitdir]}]} {
+ show_error {} . [mc "Cannot find a git repository here."]
+ exit 1
+}
if {![file isdirectory $gitdir]} {
- show_error {} . "Cannot find the git directory \"$gitdir\"."
+ show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir]
exit 1
}
+set mergeonly 0
set revtreeargs {}
set cmdline_files {}
set i 0
switch -- $arg {
"" { }
"-d" { set datemode 1 }
+ "--merge" {
+ set mergeonly 1
+ lappend revtreeargs $arg
+ }
"--" {
set cmdline_files [lrange $argv [expr {$i + 1}] end]
break
# with git log and git rev-list, check revtreeargs for filenames.
foreach arg $revtreeargs {
if {[file exists $arg]} {
- show_error {} . "Ambiguous argument '$arg': both revision\
- and filename"
+ show_error {} . [mc "Ambiguous argument '%s': both revision\
+ and filename" $arg]
exit 1
}
}
if {$i > 0} {
set err [string range $err [expr {$i + 6}] end]
}
- show_error {} . "Bad arguments to gitk:\n$err"
+ show_error {} . "[mc "Bad arguments to gitk:"]\n$err"
exit 1
}
}
+if {$mergeonly} {
+ # find the list of unmerged files
+ set mlist {}
+ set nr_unmerged 0
+ if {[catch {
+ set fd [open "| git ls-files -u" r]
+ } err]} {
+ show_error {} . "[mc "Couldn't get list of unmerged files:"] $err"
+ exit 1
+ }
+ while {[gets $fd line] >= 0} {
+ set i [string first "\t" $line]
+ if {$i < 0} continue
+ set fname [string range $line [expr {$i+1}] end]
+ if {[lsearch -exact $mlist $fname] >= 0} continue
+ incr nr_unmerged
+ if {$cmdline_files eq {} || [path_filter $cmdline_files $fname]} {
+ lappend mlist $fname
+ }
+ }
+ catch {close $fd}
+ if {$mlist eq {}} {
+ if {$nr_unmerged == 0} {
+ show_error {} . [mc "No files selected: --merge specified but\
+ no files are unmerged."]
+ } else {
+ show_error {} . [mc "No files selected: --merge specified but\
+ no unmerged files are within file limit."]
+ }
+ exit 1
+ }
+ set cmdline_files $mlist
+}
+
set nullid "0000000000000000000000000000000000000000"
set nullid2 "0000000000000000000000000000000000000001"
+set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
set runq {}
set history {}
set fh_serial 0
set nhl_names {}
set highlight_paths {}
+set findpattern {}
set searchdirn -forwards
set boldrows {}
set boldnamerows {}
set diffelide {0 0}
set markingmatches 0
-
-set optim_delay 16
+set linkentercount 0
+set need_redisplay 0
+set nrows_drawn 0
+set firsttabstop 0
set nextviewnum 1
set curview 0
set selectedview 0
set selectedhlview None
+set highlight_related None
+set highlight_files {}
set viewfiles(0) {}
set viewperm(0) 0
set viewargs(0) {}
set stopped 0
set stuffsaved 0
set patchnum 0
-set lookingforhead 0
set localirow -1
set localfrow -1
set lserial 0
set curview 1
set selectedview 1
set nextviewnum 2
- set viewname(1) "Command line"
+ set viewname(1) [mc "Command line"]
set viewfiles(1) $cmdline_files
set viewargs(1) $revtreeargs
set viewperm(1) 0
addviewmenu 1
- .bar.view entryconf Edit* -state normal
- .bar.view entryconf Delete* -state normal
+ .bar.view entryconf [mc "Edit view..."] -state normal
+ .bar.view entryconf [mc "Delete view"] -state normal
}
if {[info exists permviews]} {