Show changes to gitk +2904 −2905
diff --git a/gitk b/gitk
index da84e22dd4..7efb106e52 100755
--- a/gitk
+++ b/gitk
@@ -10,37 +10,37 @@ exec wish "$0" -- "$@"
package require Tk
proc hasworktree {} {
- return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
- [exec git rev-parse --is-inside-git-dir] == "false"}]
+ return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
+ [exec git rev-parse --is-inside-git-dir] == "false"}]
}
proc reponame {} {
- global gitdir
- set n [file normalize $gitdir]
- if {[string match "*/.git" $n]} {
- set n [string range $n 0 end-5]
- }
- return [file tail $n]
+ global gitdir
+ set n [file normalize $gitdir]
+ if {[string match "*/.git" $n]} {
+ set n [string range $n 0 end-5]
+ }
+ return [file tail $n]
}
proc gitworktree {} {
- variable _gitworktree
- if {[info exists _gitworktree]} {
+ variable _gitworktree
+ if {[info exists _gitworktree]} {
+ return $_gitworktree
+ }
+ # v1.7.0 introduced --show-toplevel to return the canonical work-tree
+ if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
+ # try to set work tree from environment, core.worktree or use
+ # cdup to obtain a relative path to the top of the worktree. If
+ # run from the top, the ./ prefix ensures normalize expands pwd.
+ if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
+ catch {set _gitworktree [exec git config --get core.worktree]}
+ if {$_gitworktree eq ""} {
+ set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
+ }
+ }
+ }
return $_gitworktree
- }
- # v1.7.0 introduced --show-toplevel to return the canonical work-tree
- if {[catch {set _gitworktree [exec git rev-parse --show-toplevel]}]} {
- # try to set work tree from environment, core.worktree or use
- # cdup to obtain a relative path to the top of the worktree. If
- # run from the top, the ./ prefix ensures normalize expands pwd.
- if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
- catch {set _gitworktree [exec git config --get core.worktree]}
- if {$_gitworktree eq ""} {
- set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]]
- }
- }
- }
- return $_gitworktree
}
# A simple scheduler for compute-intensive stuff.
@@ -49,1942 +49,1942 @@ proc gitworktree {} {
# run before X event handlers, so reading from a fast source can
# make the GUI completely unresponsive.
proc run args {
- global isonrunq runq currunq
+ global isonrunq runq currunq
- set script $args
- if {[info exists isonrunq($script)]} return
- if {$runq eq {} && ![info exists currunq]} {
- after idle dorunq
- }
- lappend runq [list {} $script]
- set isonrunq($script) 1
+ set script $args
+ if {[info exists isonrunq($script)]} return
+ if {$runq eq {} && ![info exists currunq]} {
+ after idle dorunq
+ }
+ lappend runq [list {} $script]
+ set isonrunq($script) 1
}
proc filerun {fd script} {
- fileevent $fd readable [list filereadable $fd $script]
+ fileevent $fd readable [list filereadable $fd $script]
}
proc filereadable {fd script} {
- global runq currunq
+ global runq currunq
- fileevent $fd readable {}
- if {$runq eq {} && ![info exists currunq]} {
- after idle dorunq
- }
- lappend runq [list $fd $script]
+ fileevent $fd readable {}
+ if {$runq eq {} && ![info exists currunq]} {
+ after idle dorunq
+ }
+ lappend runq [list $fd $script]
}
proc nukefile {fd} {
- global runq
+ global runq
- for {set i 0} {$i < [llength $runq]} {} {
- if {[lindex $runq $i 0] eq $fd} {
- set runq [lreplace $runq $i $i]
- } else {
- incr i
+ for {set i 0} {$i < [llength $runq]} {} {
+ if {[lindex $runq $i 0] eq $fd} {
+ set runq [lreplace $runq $i $i]
+ } else {
+ incr i
+ }
}
- }
}
proc dorunq {} {
- global isonrunq runq currunq
+ global isonrunq runq currunq
- set tstart [clock clicks -milliseconds]
- set t0 $tstart
- while {[llength $runq] > 0} {
- set fd [lindex $runq 0 0]
- set script [lindex $runq 0 1]
- set currunq [lindex $runq 0]
- set runq [lrange $runq 1 end]
- set repeat [eval $script]
- unset currunq
- set t1 [clock clicks -milliseconds]
- set t [expr {$t1 - $t0}]
- if {$repeat ne {} && $repeat} {
- if {$fd eq {} || $repeat == 2} {
- # script returns 1 if it wants to be readded
- # file readers return 2 if they could do more straight away
- lappend runq [list $fd $script]
- } else {
- fileevent $fd readable [list filereadable $fd $script]
- }
- } elseif {$fd eq {}} {
- unset isonrunq($script)
+ set tstart [clock clicks -milliseconds]
+ set t0 $tstart
+ while {[llength $runq] > 0} {
+ set fd [lindex $runq 0 0]
+ set script [lindex $runq 0 1]
+ set currunq [lindex $runq 0]
+ set runq [lrange $runq 1 end]
+ set repeat [eval $script]
+ unset currunq
+ set t1 [clock clicks -milliseconds]
+ set t [expr {$t1 - $t0}]
+ if {$repeat ne {} && $repeat} {
+ if {$fd eq {} || $repeat == 2} {
+ # script returns 1 if it wants to be readded
+ # file readers return 2 if they could do more straight away
+ lappend runq [list $fd $script]
+ } else {
+ fileevent $fd readable [list filereadable $fd $script]
+ }
+ } elseif {$fd eq {}} {
+ unset isonrunq($script)
+ }
+ set t0 $t1
+ if {$t1 - $tstart >= 80} break
+ }
+ if {$runq ne {}} {
+ after idle dorunq
}
- set t0 $t1
- if {$t1 - $tstart >= 80} break
- }
- if {$runq ne {}} {
- after idle dorunq
- }
}
proc reg_instance {fd} {
- global commfd leftover loginstance
+ global commfd leftover loginstance
- set i [incr loginstance]
- set commfd($i) $fd
- set leftover($i) {}
- return $i
+ set i [incr loginstance]
+ set commfd($i) $fd
+ set leftover($i) {}
+ return $i
}
proc unmerged_files {files} {
- global nr_unmerged
+ global nr_unmerged
- # 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 {$files eq {} || [path_filter $files $fname]} {
- lappend mlist $fname
+ # 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
}
- }
- catch {close $fd}
- return $mlist
+ 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 {$files eq {} || [path_filter $files $fname]} {
+ lappend mlist $fname
+ }
+ }
+ catch {close $fd}
+ return $mlist
}
proc parseviewargs {n arglist} {
- global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
- global vinlinediff
- global worddiff git_version
+ global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env
+ global vinlinediff
+ global worddiff git_version
- set vdatemode($n) 0
- set vmergeonly($n) 0
- set vinlinediff($n) 0
- set glflags {}
- set diffargs {}
- set nextisval 0
- set revargs {}
- set origargs $arglist
- set allknown 1
- set filtered 0
- set i -1
- foreach arg $arglist {
- incr i
- if {$nextisval} {
- lappend glflags $arg
- set nextisval 0
- continue
+ set vdatemode($n) 0
+ set vmergeonly($n) 0
+ set vinlinediff($n) 0
+ set glflags {}
+ set diffargs {}
+ set nextisval 0
+ set revargs {}
+ set origargs $arglist
+ set allknown 1
+ set filtered 0
+ set i -1
+ foreach arg $arglist {
+ incr i
+ if {$nextisval} {
+ lappend glflags $arg
+ set nextisval 0
+ continue
+ }
+ switch -glob -- $arg {
+ "-d" -
+ "--date-order" {
+ set vdatemode($n) 1
+ # remove from origargs in case we hit an unknown option
+ set origargs [lreplace $origargs $i $i]
+ incr i -1
+ }
+ "-[puabwcrRBMC]" -
+ "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
+ "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
+ "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
+ "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
+ "--ignore-space-change" - "-U*" - "--unified=*" {
+ # These request or affect diff output, which we don't want.
+ # Some could be used to set our defaults for diff display.
+ lappend diffargs $arg
+ }
+ "--raw" - "--patch-with-raw" - "--patch-with-stat" -
+ "--name-only" - "--name-status" - "--color" -
+ "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
+ "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
+ "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
+ "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
+ "--objects" - "--objects-edge" - "--reverse" {
+ # These cause our parsing of git log's output to fail, or else
+ # they're options we want to set ourselves, so ignore them.
+ }
+ "--color-words*" - "--word-diff=color" {
+ # These trigger a word diff in the console interface,
+ # so help the user by enabling our own support
+ if {[package vcompare $git_version "1.7.2"] >= 0} {
+ set worddiff [mc "Color words"]
+ }
+ }
+ "--word-diff*" {
+ if {[package vcompare $git_version "1.7.2"] >= 0} {
+ set worddiff [mc "Markup words"]
+ }
+ }
+ "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
+ "--check" - "--exit-code" - "--quiet" - "--topo-order" -
+ "--full-history" - "--dense" - "--sparse" -
+ "--follow" - "--left-right" - "--encoding=*" {
+ # These are harmless, and some are even useful
+ lappend glflags $arg
+ }
+ "--diff-filter=*" - "--no-merges" - "--unpacked" -
+ "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
+ "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
+ "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
+ "--remove-empty" - "--first-parent" - "--cherry-pick" -
+ "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
+ "--simplify-by-decoration" {
+ # These mean that we get a subset of the commits
+ set filtered 1
+ lappend glflags $arg
+ }
+ "-L*" {
+ # Line-log with 'stuck' argument (unstuck form is
+ # not supported)
+ set filtered 1
+ set vinlinediff($n) 1
+ set allknown 0
+ lappend glflags $arg
+ }
+ "-n" {
+ # This appears to be the only one that has a value as a
+ # separate word following it
+ set filtered 1
+ set nextisval 1
+ lappend glflags $arg
+ }
+ "--not" - "--all" {
+ lappend revargs $arg
+ }
+ "--merge" {
+ set vmergeonly($n) 1
+ # git rev-parse doesn't understand --merge
+ lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
+ }
+ "--no-replace-objects" {
+ set env(GIT_NO_REPLACE_OBJECTS) "1"
+ }
+ "-*" {
+ # Other flag arguments including -<n>
+ if {[string is digit -strict [string range $arg 1 end]]} {
+ set filtered 1
+ } else {
+ # a flag argument that we don't recognize;
+ # that means we can't optimize
+ set allknown 0
+ }
+ lappend glflags $arg
+ }
+ default {
+ # Non-flag arguments specify commits or ranges of commits
+ if {[string match "*...*" $arg]} {
+ lappend revargs --gitk-symmetric-diff-marker
+ }
+ lappend revargs $arg
+ }
+ }
}
- switch -glob -- $arg {
- "-d" -
- "--date-order" {
- set vdatemode($n) 1
- # remove from origargs in case we hit an unknown option
- set origargs [lreplace $origargs $i $i]
- incr i -1
- }
- "-[puabwcrRBMC]" -
- "--no-renames" - "--full-index" - "--binary" - "--abbrev=*" -
- "--find-copies-harder" - "-l*" - "--ext-diff" - "--no-ext-diff" -
- "--src-prefix=*" - "--dst-prefix=*" - "--no-prefix" -
- "-O*" - "--text" - "--full-diff" - "--ignore-space-at-eol" -
- "--ignore-space-change" - "-U*" - "--unified=*" {
- # These request or affect diff output, which we don't want.
- # Some could be used to set our defaults for diff display.
- lappend diffargs $arg
- }
- "--raw" - "--patch-with-raw" - "--patch-with-stat" -
- "--name-only" - "--name-status" - "--color" -
- "--log-size" - "--pretty=*" - "--decorate" - "--abbrev-commit" -
- "--cc" - "-z" - "--header" - "--parents" - "--boundary" -
- "--no-color" - "-g" - "--walk-reflogs" - "--no-walk" -
- "--timestamp" - "relative-date" - "--date=*" - "--stdin" -
- "--objects" - "--objects-edge" - "--reverse" {
- # These cause our parsing of git log's output to fail, or else
- # they're options we want to set ourselves, so ignore them.
- }
- "--color-words*" - "--word-diff=color" {
- # These trigger a word diff in the console interface,
- # so help the user by enabling our own support
- if {[package vcompare $git_version "1.7.2"] >= 0} {
- set worddiff [mc "Color words"]
- }
- }
- "--word-diff*" {
- if {[package vcompare $git_version "1.7.2"] >= 0} {
- set worddiff [mc "Markup words"]
- }
- }
- "--stat=*" - "--numstat" - "--shortstat" - "--summary" -
- "--check" - "--exit-code" - "--quiet" - "--topo-order" -
- "--full-history" - "--dense" - "--sparse" -
- "--follow" - "--left-right" - "--encoding=*" {
- # These are harmless, and some are even useful
- lappend glflags $arg
- }
- "--diff-filter=*" - "--no-merges" - "--unpacked" -
- "--max-count=*" - "--skip=*" - "--since=*" - "--after=*" -
- "--until=*" - "--before=*" - "--max-age=*" - "--min-age=*" -
- "--author=*" - "--committer=*" - "--grep=*" - "-[iE]" -
- "--remove-empty" - "--first-parent" - "--cherry-pick" -
- "-S*" - "-G*" - "--pickaxe-all" - "--pickaxe-regex" -
- "--simplify-by-decoration" {
- # These mean that we get a subset of the commits
- set filtered 1
- lappend glflags $arg
- }
- "-L*" {
- # Line-log with 'stuck' argument (unstuck form is
- # not supported)
- set filtered 1
- set vinlinediff($n) 1
- set allknown 0
- lappend glflags $arg
- }
- "-n" {
- # This appears to be the only one that has a value as a
- # separate word following it
- set filtered 1
- set nextisval 1
- lappend glflags $arg
- }
- "--not" - "--all" {
- lappend revargs $arg
- }
- "--merge" {
- set vmergeonly($n) 1
- # git rev-parse doesn't understand --merge
- lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD
- }
- "--no-replace-objects" {
- set env(GIT_NO_REPLACE_OBJECTS) "1"
- }
- "-*" {
- # Other flag arguments including -<n>
- if {[string is digit -strict [string range $arg 1 end]]} {
- set filtered 1
- } else {
- # a flag argument that we don't recognize;
- # that means we can't optimize
- set allknown 0
- }
- lappend glflags $arg
- }
- default {
- # Non-flag arguments specify commits or ranges of commits
- if {[string match "*...*" $arg]} {
- lappend revargs --gitk-symmetric-diff-marker
- }
- lappend revargs $arg
- }
- }
- }
- set vdflags($n) $diffargs
- set vflags($n) $glflags
- set vrevs($n) $revargs
- set vfiltered($n) $filtered
- set vorigargs($n) $origargs
- return $allknown
+ set vdflags($n) $diffargs
+ set vflags($n) $glflags
+ set vrevs($n) $revargs
+ set vfiltered($n) $filtered
+ set vorigargs($n) $origargs
+ return $allknown
}
proc parseviewrevs {view revs} {
- global vposids vnegids
+ global vposids vnegids
- if {$revs eq {}} {
- set revs HEAD
- } elseif {[lsearch -exact $revs --all] >= 0} {
- lappend revs HEAD
- }
- if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
- # we get stdout followed by stderr in $err
- # for an unknown rev, git rev-parse echoes it and then errors out
- set errlines [split $err "\n"]
- set badrev {}
- for {set l 0} {$l < [llength $errlines]} {incr l} {
- set line [lindex $errlines $l]
- if {!([string length $line] == 40 && [string is xdigit $line])} {
- if {[string match "fatal:*" $line]} {
- if {[string match "fatal: ambiguous argument*" $line]
- && $badrev ne {}} {
- if {[llength $badrev] == 1} {
- set err "unknown revision $badrev"
- } else {
- set err "unknown revisions: [join $badrev ", "]"
+ if {$revs eq {}} {
+ set revs HEAD
+ } elseif {[lsearch -exact $revs --all] >= 0} {
+ lappend revs HEAD
+ }
+ if {[catch {set ids [eval exec git rev-parse $revs]} err]} {
+ # we get stdout followed by stderr in $err
+ # for an unknown rev, git rev-parse echoes it and then errors out
+ set errlines [split $err "\n"]
+ set badrev {}
+ for {set l 0} {$l < [llength $errlines]} {incr l} {
+ set line [lindex $errlines $l]
+ if {!([string length $line] == 40 && [string is xdigit $line])} {
+ if {[string match "fatal:*" $line]} {
+ if {[string match "fatal: ambiguous argument*" $line]
+ && $badrev ne {}} {
+ if {[llength $badrev] == 1} {
+ set err "unknown revision $badrev"
+ } else {
+ set err "unknown revisions: [join $badrev ", "]"
+ }
+ } else {
+ set err [join [lrange $errlines $l end] "\n"]
+ }
+ break
+ }
+ lappend badrev $line
}
- } else {
- set err [join [lrange $errlines $l end] "\n"]
- }
- break
}
- lappend badrev $line
- }
+ error_popup "[mc "Error parsing revisions:"] $err"
+ return {}
}
- error_popup "[mc "Error parsing revisions:"] $err"
- return {}
- }
- set ret {}
- set pos {}
- set neg {}
- set sdm 0
- foreach id [split $ids "\n"] {
- if {$id eq "--gitk-symmetric-diff-marker"} {
- set sdm 4
- } elseif {[string match "^*" $id]} {
- if {$sdm != 1} {
- lappend ret $id
- if {$sdm == 3} {
- set sdm 0
+ set ret {}
+ set pos {}
+ set neg {}
+ set sdm 0
+ foreach id [split $ids "\n"] {
+ if {$id eq "--gitk-symmetric-diff-marker"} {
+ set sdm 4
+ } elseif {[string match "^*" $id]} {
+ if {$sdm != 1} {
+ lappend ret $id
+ if {$sdm == 3} {
+ set sdm 0
+ }
+ }
+ lappend neg [string range $id 1 end]
+ } else {
+ if {$sdm != 2} {
+ lappend ret $id
+ } else {
+ lset ret end $id...[lindex $ret end]
+ }
+ lappend pos $id
}
- }
- lappend neg [string range $id 1 end]
- } else {
- if {$sdm != 2} {
- lappend ret $id
- } else {
- lset ret end $id...[lindex $ret end]
- }
- lappend pos $id
+ incr sdm -1
}
- incr sdm -1
- }
- set vposids($view) $pos
- set vnegids($view) $neg
- return $ret
+ set vposids($view) $pos
+ set vnegids($view) $neg
+ return $ret
}
# Start off a git log process and arrange to read its output
proc start_rev_list {view} {
- global startmsecs commitidx viewcomplete curview
- global tclencoding
- global viewargs viewargscmd viewfiles vfilelimit
- global showlocalchanges
- global viewactive viewinstances vmergeonly
- global mainheadid viewmainheadid viewmainheadid_orig
- global vcanopt vflags vrevs vorigargs
- global show_notes
+ global startmsecs commitidx viewcomplete curview
+ global tclencoding
+ global viewargs viewargscmd viewfiles vfilelimit
+ global showlocalchanges
+ global viewactive viewinstances vmergeonly
+ global mainheadid viewmainheadid viewmainheadid_orig
+ global vcanopt vflags vrevs vorigargs
+ global show_notes
- set startmsecs [clock clicks -milliseconds]
- set commitidx($view) 0
- # these are set this way for the error exits
- set viewcomplete($view) 1
- set viewactive($view) 0
- varcinit $view
+ set startmsecs [clock clicks -milliseconds]
+ set commitidx($view) 0
+ # these are set this way for the error exits
+ set viewcomplete($view) 1
+ set viewactive($view) 0
+ varcinit $view
+
+ set args $viewargs($view)
+ if {$viewargscmd($view) ne {}} {
+ if {[catch {
+ set str [exec sh -c $viewargscmd($view)]
+ } err]} {
+ error_popup "[mc "Error executing --argscmd command:"] $err"
+ return 0
+ }
+ set args [concat $args [split $str "\n"]]
+ }
+ set vcanopt($view) [parseviewargs $view $args]
+
+ set files $viewfiles($view)
+ if {$vmergeonly($view)} {
+ set files [unmerged_files $files]
+ if {$files eq {}} {
+ global nr_unmerged
+ if {$nr_unmerged == 0} {
+ error_popup [mc "No files selected: --merge specified but\
+ no files are unmerged."]
+ } else {
+ error_popup [mc "No files selected: --merge specified but\
+ no unmerged files are within file limit."]
+ }
+ return 0
+ }
+ }
+ set vfilelimit($view) $files
+
+ if {$vcanopt($view)} {
+ set revs [parseviewrevs $view $vrevs($view)]
+ if {$revs eq {}} {
+ return 0
+ }
+ set args [concat $vflags($view) $revs]
+ } else {
+ set args $vorigargs($view)
+ }
- set args $viewargs($view)
- if {$viewargscmd($view) ne {}} {
if {[catch {
- set str [exec sh -c $viewargscmd($view)]
+ set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
+ --parents --boundary $args "--" $files] r]
} err]} {
- error_popup "[mc "Error executing --argscmd command:"] $err"
- return 0
+ error_popup "[mc "Error executing git log:"] $err"
+ return 0
}
- set args [concat $args [split $str "\n"]]
- }
- set vcanopt($view) [parseviewargs $view $args]
-
- set files $viewfiles($view)
- if {$vmergeonly($view)} {
- set files [unmerged_files $files]
- if {$files eq {}} {
- global nr_unmerged
- if {$nr_unmerged == 0} {
- error_popup [mc "No files selected: --merge specified but\
- no files are unmerged."]
- } else {
- error_popup [mc "No files selected: --merge specified but\
- no unmerged files are within file limit."]
- }
- return 0
+ set i [reg_instance $fd]
+ set viewinstances($view) [list $i]
+ set viewmainheadid($view) $mainheadid
+ set viewmainheadid_orig($view) $mainheadid
+ if {$files ne {} && $mainheadid ne {}} {
+ get_viewmainhead $view
}
- }
- set vfilelimit($view) $files
-
- if {$vcanopt($view)} {
- set revs [parseviewrevs $view $vrevs($view)]
- if {$revs eq {}} {
- return 0
+ if {$showlocalchanges && $viewmainheadid($view) ne {}} {
+ interestedin $viewmainheadid($view) dodiffindex
}
- set args [concat $vflags($view) $revs]
- } else {
- set args $vorigargs($view)
- }
-
- if {[catch {
- set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
- --parents --boundary $args "--" $files] r]
- } err]} {
- error_popup "[mc "Error executing git log:"] $err"
- return 0
- }
- set i [reg_instance $fd]
- set viewinstances($view) [list $i]
- set viewmainheadid($view) $mainheadid
- set viewmainheadid_orig($view) $mainheadid
- if {$files ne {} && $mainheadid ne {}} {
- get_viewmainhead $view
- }
- if {$showlocalchanges && $viewmainheadid($view) ne {}} {
- interestedin $viewmainheadid($view) dodiffindex
- }
- fconfigure $fd -blocking 0 -translation lf -eofchar {}
- if {$tclencoding != {}} {
- fconfigure $fd -encoding $tclencoding
- }
- filerun $fd [list getcommitlines $fd $i $view 0]
- nowbusy $view [mc "Reading"]
- set viewcomplete($view) 0
- set viewactive($view) 1
- return 1
+ fconfigure $fd -blocking 0 -translation lf -eofchar {}
+ if {$tclencoding != {}} {
+ fconfigure $fd -encoding $tclencoding
+ }
+ filerun $fd [list getcommitlines $fd $i $view 0]
+ nowbusy $view [mc "Reading"]
+ set viewcomplete($view) 0
+ set viewactive($view) 1
+ return 1
}
proc stop_instance {inst} {
- global commfd leftover
+ global commfd leftover
- set fd $commfd($inst)
- catch {
- set pid [pid $fd]
+ set fd $commfd($inst)
+ catch {
+ set pid [pid $fd]
- if {$::tcl_platform(platform) eq {windows}} {
- exec taskkill /pid $pid
- } else {
- exec kill $pid
+ if {$::tcl_platform(platform) eq {windows}} {
+ exec taskkill /pid $pid
+ } else {
+ exec kill $pid
+ }
}
- }
- catch {close $fd}
- nukefile $fd
- unset commfd($inst)
- unset leftover($inst)
+ catch {close $fd}
+ nukefile $fd
+ unset commfd($inst)
+ unset leftover($inst)
}
proc stop_backends {} {
- global commfd
+ global commfd
- foreach inst [array names commfd] {
- stop_instance $inst
- }
+ foreach inst [array names commfd] {
+ stop_instance $inst
+ }
}
proc stop_rev_list {view} {
- global viewinstances
+ global viewinstances
- foreach inst $viewinstances($view) {
- stop_instance $inst
- }
- set viewinstances($view) {}
+ foreach inst $viewinstances($view) {
+ stop_instance $inst
+ }
+ set viewinstances($view) {}
}
proc reset_pending_select {selid} {
- global pending_select mainheadid selectheadid
+ global pending_select mainheadid selectheadid
- if {$selid ne {}} {
- set pending_select $selid
- } elseif {$selectheadid ne {}} {
- set pending_select $selectheadid
- } else {
- set pending_select $mainheadid
- }
+ if {$selid ne {}} {
+ set pending_select $selid
+ } elseif {$selectheadid ne {}} {
+ set pending_select $selectheadid
+ } else {
+ set pending_select $mainheadid
+ }
}
proc getcommits {selid} {
- global canv curview need_redisplay viewactive
+ global canv curview need_redisplay viewactive
- initlayout
- if {[start_rev_list $curview]} {
- reset_pending_select $selid
- show_status [mc "Reading commits..."]
- set need_redisplay 1
- } else {
- show_status [mc "No commits selected"]
- }
+ initlayout
+ if {[start_rev_list $curview]} {
+ reset_pending_select $selid
+ show_status [mc "Reading commits..."]
+ set need_redisplay 1
+ } else {
+ show_status [mc "No commits selected"]
+ }
}
proc updatecommits {} {
- global curview vcanopt vorigargs vfilelimit viewinstances
- global viewactive viewcomplete tclencoding
- global startmsecs showneartags showlocalchanges
- global mainheadid viewmainheadid viewmainheadid_orig pending_select
- global hasworktree
- global varcid vposids vnegids vflags vrevs
- global show_notes
+ global curview vcanopt vorigargs vfilelimit viewinstances
+ global viewactive viewcomplete tclencoding
+ global startmsecs showneartags showlocalchanges
+ global mainheadid viewmainheadid viewmainheadid_orig pending_select
+ global hasworktree
+ global varcid vposids vnegids vflags vrevs
+ global show_notes
- set hasworktree [hasworktree]
- rereadrefs
- set view $curview
- if {$mainheadid ne $viewmainheadid_orig($view)} {
- if {$showlocalchanges} {
- dohidelocalchanges
- }
- set viewmainheadid($view) $mainheadid
- set viewmainheadid_orig($view) $mainheadid
- if {$vfilelimit($view) ne {}} {
- get_viewmainhead $view
- }
- }
- if {$showlocalchanges} {
- doshowlocalchanges
- }
- if {$vcanopt($view)} {
- set oldpos $vposids($view)
- set oldneg $vnegids($view)
- set revs [parseviewrevs $view $vrevs($view)]
- if {$revs eq {}} {
- return
- }
- # note: getting the delta when negative refs change is hard,
- # and could require multiple git log invocations, so in that
- # case we ask git log for all the commits (not just the delta)
- if {$oldneg eq $vnegids($view)} {
- set newrevs {}
- set npos 0
- # take out positive refs that we asked for before or
- # that we have already seen
- foreach rev $revs {
- if {[string length $rev] == 40} {
- if {[lsearch -exact $oldpos $rev] < 0
- && ![info exists varcid($view,$rev)]} {
- lappend newrevs $rev
- incr npos
- }
- } else {
- lappend $newrevs $rev
+ set hasworktree [hasworktree]
+ rereadrefs
+ set view $curview
+ if {$mainheadid ne $viewmainheadid_orig($view)} {
+ if {$showlocalchanges} {
+ dohidelocalchanges
+ }
+ set viewmainheadid($view) $mainheadid
+ set viewmainheadid_orig($view) $mainheadid
+ if {$vfilelimit($view) ne {}} {
+ get_viewmainhead $view
}
- }
- if {$npos == 0} return
- set revs $newrevs
- set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
}
- set args [concat $vflags($view) $revs --not $oldpos]
- } else {
- set args $vorigargs($view)
- }
- if {[catch {
- set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
- --parents --boundary $args "--" $vfilelimit($view)] r]
- } err]} {
- error_popup "[mc "Error executing git log:"] $err"
- return
- }
- if {$viewactive($view) == 0} {
- set startmsecs [clock clicks -milliseconds]
- }
- set i [reg_instance $fd]
- lappend viewinstances($view) $i
- fconfigure $fd -blocking 0 -translation lf -eofchar {}
- if {$tclencoding != {}} {
- fconfigure $fd -encoding $tclencoding
- }
- filerun $fd [list getcommitlines $fd $i $view 1]
- incr viewactive($view)
- set viewcomplete($view) 0
- reset_pending_select {}
- nowbusy $view [mc "Reading"]
- if {$showneartags} {
- getallcommits
- }
+ if {$showlocalchanges} {
+ doshowlocalchanges
+ }
+ if {$vcanopt($view)} {
+ set oldpos $vposids($view)
+ set oldneg $vnegids($view)
+ set revs [parseviewrevs $view $vrevs($view)]
+ if {$revs eq {}} {
+ return
+ }
+ # note: getting the delta when negative refs change is hard,
+ # and could require multiple git log invocations, so in that
+ # case we ask git log for all the commits (not just the delta)
+ if {$oldneg eq $vnegids($view)} {
+ set newrevs {}
+ set npos 0
+ # take out positive refs that we asked for before or
+ # that we have already seen
+ foreach rev $revs {
+ if {[string length $rev] == 40} {
+ if {[lsearch -exact $oldpos $rev] < 0
+ && ![info exists varcid($view,$rev)]} {
+ lappend newrevs $rev
+ incr npos
+ }
+ } else {
+ lappend $newrevs $rev
+ }
+ }
+ if {$npos == 0} return
+ set revs $newrevs
+ set vposids($view) [lsort -unique [concat $oldpos $vposids($view)]]
+ }
+ set args [concat $vflags($view) $revs --not $oldpos]
+ } else {
+ set args $vorigargs($view)
+ }
+ if {[catch {
+ set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \
+ --parents --boundary $args "--" $vfilelimit($view)] r]
+ } err]} {
+ error_popup "[mc "Error executing git log:"] $err"
+ return
+ }
+ if {$viewactive($view) == 0} {
+ set startmsecs [clock clicks -milliseconds]
+ }
+ set i [reg_instance $fd]
+ lappend viewinstances($view) $i
+ fconfigure $fd -blocking 0 -translation lf -eofchar {}
+ if {$tclencoding != {}} {
+ fconfigure $fd -encoding $tclencoding
+ }
+ filerun $fd [list getcommitlines $fd $i $view 1]
+ incr viewactive($view)
+ set viewcomplete($view) 0
+ reset_pending_select {}
+ nowbusy $view [mc "Reading"]
+ if {$showneartags} {
+ getallcommits
+ }
}
proc reloadcommits {} {
- global curview viewcomplete selectedline currentid thickerline
- global showneartags treediffs commitinterest cached_commitrow
- global targetid commitinfo
+ global curview viewcomplete selectedline currentid thickerline
+ global showneartags treediffs commitinterest cached_commitrow
+ global targetid commitinfo
- set selid {}
- if {$selectedline ne {}} {
- set selid $currentid
- }
+ set selid {}
+ if {$selectedline ne {}} {
+ set selid $currentid
+ }
- if {!$viewcomplete($curview)} {
- stop_rev_list $curview
- }
- resetvarcs $curview
- set selectedline {}
- unset -nocomplain currentid
- unset -nocomplain thickerline
- unset -nocomplain treediffs
- readrefs
- changedrefs
- if {$showneartags} {
- getallcommits
- }
- clear_display
- unset -nocomplain commitinfo
- unset -nocomplain commitinterest
- unset -nocomplain cached_commitrow
- unset -nocomplain targetid
- setcanvscroll
- getcommits $selid
- return 0
+ if {!$viewcomplete($curview)} {
+ stop_rev_list $curview
+ }
+ resetvarcs $curview
+ set selectedline {}
+ unset -nocomplain currentid
+ unset -nocomplain thickerline
+ unset -nocomplain treediffs
+ readrefs
+ changedrefs
+ if {$showneartags} {
+ getallcommits
+ }
+ clear_display
+ unset -nocomplain commitinfo
+ unset -nocomplain commitinterest
+ unset -nocomplain cached_commitrow
+ unset -nocomplain targetid
+ setcanvscroll
+ getcommits $selid
+ return 0
}
# This makes a string representation of a positive integer which
# sorts as a string in numerical order
proc strrep {n} {
- if {$n < 16} {
- return [format "%x" $n]
- } elseif {$n < 256} {
- return [format "x%.2x" $n]
- } elseif {$n < 65536} {
- return [format "y%.4x" $n]
- }
- return [format "z%.8x" $n]
+ if {$n < 16} {
+ return [format "%x" $n]
+ } elseif {$n < 256} {
+ return [format "x%.2x" $n]
+ } elseif {$n < 65536} {
+ return [format "y%.4x" $n]
+ }
+ return [format "z%.8x" $n]
}
# Procedures used in reordering commits from git log (without
# --topo-order) into the order for display.
proc varcinit {view} {
- global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
- global vtokmod varcmod vrowmod varcix vlastins
+ global varcstart vupptr vdownptr vleftptr vbackptr varctok varcrow
+ global vtokmod varcmod vrowmod varcix vlastins
- set varcstart($view) {{}}
- set vupptr($view) {0}
- set vdownptr($view) {0}
- set vleftptr($view) {0}
- set vbackptr($view) {0}
- set varctok($view) {{}}
- set varcrow($view) {{}}
- set vtokmod($view) {}
- set varcmod($view) 0
- set vrowmod($view) 0
- set varcix($view) {{}}
- set vlastins($view) {0}
+ set varcstart($view) {{}}
+ set vupptr($view) {0}
+ set vdownptr($view) {0}
+ set vleftptr($view) {0}
+ set vbackptr($view) {0}
+ set varctok($view) {{}}
+ set varcrow($view) {{}}
+ set vtokmod($view) {}
+ set varcmod($view) 0
+ set vrowmod($view) 0
+ set varcix($view) {{}}
+ set vlastins($view) {0}
}
proc resetvarcs {view} {
- global varcid varccommits parents children vseedcount ordertok
- global vshortids
+ global varcid varccommits parents children vseedcount ordertok
+ global vshortids
- foreach vid [array names varcid $view,*] {
- unset varcid($vid)
- unset children($vid)
- unset parents($vid)
- }
- foreach vid [array names vshortids $view,*] {
- unset vshortids($vid)
- }
- # some commits might have children but haven't been seen yet
- foreach vid [array names children $view,*] {
- unset children($vid)
- }
- foreach va [array names varccommits $view,*] {
- unset varccommits($va)
- }
- foreach vd [array names vseedcount $view,*] {
- unset vseedcount($vd)
- }
- unset -nocomplain ordertok
+ foreach vid [array names varcid $view,*] {
+ unset varcid($vid)
+ unset children($vid)
+ unset parents($vid)
+ }
+ foreach vid [array names vshortids $view,*] {
+ unset vshortids($vid)
+ }
+ # some commits might have children but haven't been seen yet
+ foreach vid [array names children $view,*] {
+ unset children($vid)
+ }
+ foreach va [array names varccommits $view,*] {
+ unset varccommits($va)
+ }
+ foreach vd [array names vseedcount $view,*] {
+ unset vseedcount($vd)
+ }
+ unset -nocomplain ordertok
}
# returns a list of the commits with no children
proc seeds {v} {
- global vdownptr vleftptr varcstart
+ global vdownptr vleftptr varcstart
- set ret {}
- set a [lindex $vdownptr($v) 0]
- while {$a != 0} {
- lappend ret [lindex $varcstart($v) $a]
- set a [lindex $vleftptr($v) $a]
- }
- return $ret
+ set ret {}
+ set a [lindex $vdownptr($v) 0]
+ while {$a != 0} {
+ lappend ret [lindex $varcstart($v) $a]
+ set a [lindex $vleftptr($v) $a]
+ }
+ return $ret
}
proc newvarc {view id} {
- global varcid varctok parents children vdatemode
- global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
- global commitdata commitinfo vseedcount varccommits vlastins
+ global varcid varctok parents children vdatemode
+ global vupptr vdownptr vleftptr vbackptr varcrow varcix varcstart
+ global commitdata commitinfo vseedcount varccommits vlastins
- set a [llength $varctok($view)]
- set vid $view,$id
- if {[llength $children($vid)] == 0 || $vdatemode($view)} {
- if {![info exists commitinfo($id)]} {
- parsecommit $id $commitdata($id) 1
+ set a [llength $varctok($view)]
+ set vid $view,$id
+ if {[llength $children($vid)] == 0 || $vdatemode($view)} {
+ if {![info exists commitinfo($id)]} {
+ parsecommit $id $commitdata($id) 1
+ }
+ set cdate [lindex [lindex $commitinfo($id) 4] 0]
+ if {![string is integer -strict $cdate]} {
+ set cdate 0
+ }
+ if {![info exists vseedcount($view,$cdate)]} {
+ set vseedcount($view,$cdate) -1
+ }
+ set c [incr vseedcount($view,$cdate)]
+ set cdate [expr {$cdate ^ 0xffffffff}]
+ set tok "s[strrep $cdate][strrep $c]"
+ } else {
+ set tok {}
}
- set cdate [lindex [lindex $commitinfo($id) 4] 0]
- if {![string is integer -strict $cdate]} {
- set cdate 0
+ set ka 0
+ if {[llength $children($vid)] > 0} {
+ set kid [lindex $children($vid) end]
+ set k $varcid($view,$kid)
+ if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
+ set ki $kid
+ set ka $k
+ set tok [lindex $varctok($view) $k]
+ }
}
- if {![info exists vseedcount($view,$cdate)]} {
- set vseedcount($view,$cdate) -1
+ if {$ka != 0} {
+ set i [lsearch -exact $parents($view,$ki) $id]
+ set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
+ append tok [strrep $j]
}
- set c [incr vseedcount($view,$cdate)]
- set cdate [expr {$cdate ^ 0xffffffff}]
- set tok "s[strrep $cdate][strrep $c]"
- } else {
- set tok {}
- }
- set ka 0
- if {[llength $children($vid)] > 0} {
- set kid [lindex $children($vid) end]
- set k $varcid($view,$kid)
- if {[string compare [lindex $varctok($view) $k] $tok] > 0} {
- set ki $kid
- set ka $k
- set tok [lindex $varctok($view) $k]
+ set c [lindex $vlastins($view) $ka]
+ if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
+ set c $ka
+ set b [lindex $vdownptr($view) $ka]
+ } else {
+ set b [lindex $vleftptr($view) $c]
}
- }
- if {$ka != 0} {
- set i [lsearch -exact $parents($view,$ki) $id]
- set j [expr {[llength $parents($view,$ki)] - 1 - $i}]
- append tok [strrep $j]
- }
- set c [lindex $vlastins($view) $ka]
- if {$c == 0 || [string compare $tok [lindex $varctok($view) $c]] < 0} {
- set c $ka
- set b [lindex $vdownptr($view) $ka]
- } else {
- set b [lindex $vleftptr($view) $c]
- }
- while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
- set c $b
- set b [lindex $vleftptr($view) $c]
- }
- if {$c == $ka} {
- lset vdownptr($view) $ka $a
- lappend vbackptr($view) 0
- } else {
- lset vleftptr($view) $c $a
- lappend vbackptr($view) $c
- }
- lset vlastins($view) $ka $a
- lappend vupptr($view) $ka
- lappend vleftptr($view) $b
- if {$b != 0} {
- lset vbackptr($view) $b $a
- }
- lappend varctok($view) $tok
- lappend varcstart($view) $id
- lappend vdownptr($view) 0
- lappend varcrow($view) {}
- lappend varcix($view) {}
- set varccommits($view,$a) {}
- lappend vlastins($view) 0
- return $a
+ while {$b != 0 && [string compare $tok [lindex $varctok($view) $b]] >= 0} {
+ set c $b
+ set b [lindex $vleftptr($view) $c]
+ }
+ if {$c == $ka} {
+ lset vdownptr($view) $ka $a
+ lappend vbackptr($view) 0
+ } else {
+ lset vleftptr($view) $c $a
+ lappend vbackptr($view) $c
+ }
+ lset vlastins($view) $ka $a
+ lappend vupptr($view) $ka
+ lappend vleftptr($view) $b
+ if {$b != 0} {
+ lset vbackptr($view) $b $a
+ }
+ lappend varctok($view) $tok
+ lappend varcstart($view) $id
+ lappend vdownptr($view) 0
+ lappend varcrow($view) {}
+ lappend varcix($view) {}
+ set varccommits($view,$a) {}
+ lappend vlastins($view) 0
+ return $a
}
proc splitvarc {p v} {
- global varcid varcstart varccommits varctok vtokmod
- global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
+ global varcid varcstart varccommits varctok vtokmod
+ global vupptr vdownptr vleftptr vbackptr varcix varcrow vlastins
- set oa $varcid($v,$p)
- set otok [lindex $varctok($v) $oa]
- set ac $varccommits($v,$oa)
- set i [lsearch -exact $varccommits($v,$oa) $p]
- if {$i <= 0} return
- set na [llength $varctok($v)]
- # "%" sorts before "0"...
- set tok "$otok%[strrep $i]"
- lappend varctok($v) $tok
- lappend varcrow($v) {}
- lappend varcix($v) {}
- set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
- set varccommits($v,$na) [lrange $ac $i end]
- lappend varcstart($v) $p
- foreach id $varccommits($v,$na) {
- set varcid($v,$id) $na
- }
- lappend vdownptr($v) [lindex $vdownptr($v) $oa]
- lappend vlastins($v) [lindex $vlastins($v) $oa]
- lset vdownptr($v) $oa $na
- lset vlastins($v) $oa 0
- lappend vupptr($v) $oa
- lappend vleftptr($v) 0
- lappend vbackptr($v) 0
- for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
- lset vupptr($v) $b $na
- }
- if {[string compare $otok $vtokmod($v)] <= 0} {
- modify_arc $v $oa
- }
+ set oa $varcid($v,$p)
+ set otok [lindex $varctok($v) $oa]
+ set ac $varccommits($v,$oa)
+ set i [lsearch -exact $varccommits($v,$oa) $p]
+ if {$i <= 0} return
+ set na [llength $varctok($v)]
+ # "%" sorts before "0"...
+ set tok "$otok%[strrep $i]"
+ lappend varctok($v) $tok
+ lappend varcrow($v) {}
+ lappend varcix($v) {}
+ set varccommits($v,$oa) [lrange $ac 0 [expr {$i - 1}]]
+ set varccommits($v,$na) [lrange $ac $i end]
+ lappend varcstart($v) $p
+ foreach id $varccommits($v,$na) {
+ set varcid($v,$id) $na
+ }
+ lappend vdownptr($v) [lindex $vdownptr($v) $oa]
+ lappend vlastins($v) [lindex $vlastins($v) $oa]
+ lset vdownptr($v) $oa $na
+ lset vlastins($v) $oa 0
+ lappend vupptr($v) $oa
+ lappend vleftptr($v) 0
+ lappend vbackptr($v) 0
+ for {set b [lindex $vdownptr($v) $na]} {$b != 0} {set b [lindex $vleftptr($v) $b]} {
+ lset vupptr($v) $b $na
+ }
+ if {[string compare $otok $vtokmod($v)] <= 0} {
+ modify_arc $v $oa
+ }
}
proc renumbervarc {a v} {
- global parents children varctok varcstart varccommits
- global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
+ global parents children varctok varcstart varccommits
+ global vupptr vdownptr vleftptr vbackptr vlastins varcid vtokmod vdatemode
- set t1 [clock clicks -milliseconds]
- set todo {}
- set isrelated($a) 1
- set kidchanged($a) 1
- set ntot 0
- while {$a != 0} {
- if {[info exists isrelated($a)]} {
- lappend todo $a
- set id [lindex $varccommits($v,$a) end]
- foreach p $parents($v,$id) {
- if {[info exists varcid($v,$p)]} {
- set isrelated($varcid($v,$p)) 1
+ set t1 [clock clicks -milliseconds]
+ set todo {}
+ set isrelated($a) 1
+ set kidchanged($a) 1
+ set ntot 0
+ while {$a != 0} {
+ if {[info exists isrelated($a)]} {
+ lappend todo $a
+ set id [lindex $varccommits($v,$a) end]
+ foreach p $parents($v,$id) {
+ if {[info exists varcid($v,$p)]} {
+ set isrelated($varcid($v,$p)) 1
+ }
+ }
}
- }
+ incr ntot
+ set b [lindex $vdownptr($v) $a]
+ if {$b == 0} {
+ while {$a != 0} {
+ set b [lindex $vleftptr($v) $a]
+ if {$b != 0} break
+ set a [lindex $vupptr($v) $a]
+ }
+ }
+ set a $b
}
- incr ntot
- set b [lindex $vdownptr($v) $a]
- if {$b == 0} {
- while {$a != 0} {
- set b [lindex $vleftptr($v) $a]
- if {$b != 0} break
- set a [lindex $vupptr($v) $a]
- }
+ foreach a $todo {
+ if {![info exists kidchanged($a)]} continue
+ set id [lindex $varcstart($v) $a]
+ if {[llength $children($v,$id)] > 1} {
+ set children($v,$id) [lsort -command [list vtokcmp $v] \
+ $children($v,$id)]
+ }
+ set oldtok [lindex $varctok($v) $a]
+ if {!$vdatemode($v)} {
+ set tok {}
+ } else {
+ set tok $oldtok
+ }
+ set ka 0
+ set kid [last_real_child $v,$id]
+ if {$kid ne {}} {
+ set k $varcid($v,$kid)
+ if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
+ set ki $kid
+ set ka $k
+ set tok [lindex $varctok($v) $k]
+ }
+ }
+ if {$ka != 0} {
+ set i [lsearch -exact $parents($v,$ki) $id]
+ set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
+ append tok [strrep $j]
+ }
+ if {$tok eq $oldtok} {
+ continue
+ }
+ set id [lindex $varccommits($v,$a) end]
+ foreach p $parents($v,$id) {
+ if {[info exists varcid($v,$p)]} {
+ set kidchanged($varcid($v,$p)) 1
+ } else {
+ set sortkids($p) 1
+ }
+ }
+ lset varctok($v) $a $tok
+ set b [lindex $vupptr($v) $a]
+ if {$b != $ka} {
+ if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
+ modify_arc $v $ka
+ }
+ if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
+ modify_arc $v $b
+ }
+ set c [lindex $vbackptr($v) $a]
+ set d [lindex $vleftptr($v) $a]
+ if {$c == 0} {
+ lset vdownptr($v) $b $d
+ } else {
+ lset vleftptr($v) $c $d
+ }
+ if {$d != 0} {
+ lset vbackptr($v) $d $c
+ }
+ if {[lindex $vlastins($v) $b] == $a} {
+ lset vlastins($v) $b $c
+ }
+ lset vupptr($v) $a $ka
+ set c [lindex $vlastins($v) $ka]
+ if {$c == 0 || \
+ [string compare $tok [lindex $varctok($v) $c]] < 0} {
+ set c $ka
+ set b [lindex $vdownptr($v) $ka]
+ } else {
+ set b [lindex $vleftptr($v) $c]
+ }
+ while {$b != 0 && \
+ [string compare $tok [lindex $varctok($v) $b]] >= 0} {
+ set c $b
+ set b [lindex $vleftptr($v) $c]
+ }
+ if {$c == $ka} {
+ lset vdownptr($v) $ka $a
+ lset vbackptr($v) $a 0
+ } else {
+ lset vleftptr($v) $c $a
+ lset vbackptr($v) $a $c
+ }
+ lset vleftptr($v) $a $b
+ if {$b != 0} {
+ lset vbackptr($v) $b $a
+ }
+ lset vlastins($v) $ka $a
+ }
}
- set a $b
- }
- foreach a $todo {
- if {![info exists kidchanged($a)]} continue
- set id [lindex $varcstart($v) $a]
- if {[llength $children($v,$id)] > 1} {
- set children($v,$id) [lsort -command [list vtokcmp $v] \
- $children($v,$id)]
+ foreach id [array names sortkids] {
+ if {[llength $children($v,$id)] > 1} {
+ set children($v,$id) [lsort -command [list vtokcmp $v] \
+ $children($v,$id)]
+ }
}
- set oldtok [lindex $varctok($v) $a]
- if {!$vdatemode($v)} {
- set tok {}
- } else {
- set tok $oldtok
- }
- set ka 0
- set kid [last_real_child $v,$id]
- if {$kid ne {}} {
- set k $varcid($v,$kid)
- if {[string compare [lindex $varctok($v) $k] $tok] > 0} {
- set ki $kid
- set ka $k
- set tok [lindex $varctok($v) $k]
- }
- }
- if {$ka != 0} {
- set i [lsearch -exact $parents($v,$ki) $id]
- set j [expr {[llength $parents($v,$ki)] - 1 - $i}]
- append tok [strrep $j]
- }
- if {$tok eq $oldtok} {
- continue
- }
- set id [lindex $varccommits($v,$a) end]
- foreach p $parents($v,$id) {
- if {[info exists varcid($v,$p)]} {
- set kidchanged($varcid($v,$p)) 1
- } else {
- set sortkids($p) 1
- }
- }
- lset varctok($v) $a $tok
- set b [lindex $vupptr($v) $a]
- if {$b != $ka} {
- if {[string compare [lindex $varctok($v) $ka] $vtokmod($v)] < 0} {
- modify_arc $v $ka
- }
- if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
- modify_arc $v $b
- }
- set c [lindex $vbackptr($v) $a]
- set d [lindex $vleftptr($v) $a]
- if {$c == 0} {
- lset vdownptr($v) $b $d
- } else {
- lset vleftptr($v) $c $d
- }
- if {$d != 0} {
- lset vbackptr($v) $d $c
- }
- if {[lindex $vlastins($v) $b] == $a} {
- lset vlastins($v) $b $c
- }
- lset vupptr($v) $a $ka
- set c [lindex $vlastins($v) $ka]
- if {$c == 0 || \
- [string compare $tok [lindex $varctok($v) $c]] < 0} {
- set c $ka
- set b [lindex $vdownptr($v) $ka]
- } else {
- set b [lindex $vleftptr($v) $c]
- }
- while {$b != 0 && \
- [string compare $tok [lindex $varctok($v) $b]] >= 0} {
- set c $b
- set b [lindex $vleftptr($v) $c]
- }
- if {$c == $ka} {
- lset vdownptr($v) $ka $a
- lset vbackptr($v) $a 0
- } else {
- lset vleftptr($v) $c $a
- lset vbackptr($v) $a $c
- }
- lset vleftptr($v) $a $b
- if {$b != 0} {
- lset vbackptr($v) $b $a
- }
- lset vlastins($v) $ka $a
- }
- }
- foreach id [array names sortkids] {
- if {[llength $children($v,$id)] > 1} {
- set children($v,$id) [lsort -command [list vtokcmp $v] \
- $children($v,$id)]
- }
- }
- set t2 [clock clicks -milliseconds]
- #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
+ set t2 [clock clicks -milliseconds]
+ #puts "renumbervarc did [llength $todo] of $ntot arcs in [expr {$t2-$t1}]ms"
}
# Fix up the graph after we have found out that in view $v,
# $p (a commit that we have already seen) is actually the parent
# of the last commit in arc $a.
proc fix_reversal {p a v} {
- global varcid varcstart varctok vupptr
+ global varcid varcstart varctok vupptr
- set pa $varcid($v,$p)
- if {$p ne [lindex $varcstart($v) $pa]} {
- splitvarc $p $v
set pa $varcid($v,$p)
- }
- # seeds always need to be renumbered
- if {[lindex $vupptr($v) $pa] == 0 ||
- [string compare [lindex $varctok($v) $a] \
- [lindex $varctok($v) $pa]] > 0} {
- renumbervarc $pa $v
- }
+ if {$p ne [lindex $varcstart($v) $pa]} {
+ splitvarc $p $v
+ set pa $varcid($v,$p)
+ }
+ # seeds always need to be renumbered
+ if {[lindex $vupptr($v) $pa] == 0 ||
+ [string compare [lindex $varctok($v) $a] \
+ [lindex $varctok($v) $pa]] > 0} {
+ renumbervarc $pa $v
+ }
}
proc insertrow {id p v} {
- global cmitlisted children parents varcid varctok vtokmod
- global varccommits ordertok commitidx numcommits curview
- global targetid targetrow vshortids
+ global cmitlisted children parents varcid varctok vtokmod
+ global varccommits ordertok commitidx numcommits curview
+ global targetid targetrow vshortids
- readcommit $id
- set vid $v,$id
- set cmitlisted($vid) 1
- set children($vid) {}
- set parents($vid) [list $p]
- set a [newvarc $v $id]
- set varcid($vid) $a
- lappend vshortids($v,[string range $id 0 3]) $id
- if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
- modify_arc $v $a
- }
- lappend varccommits($v,$a) $id
- set vp $v,$p
- if {[llength [lappend children($vp) $id]] > 1} {
- set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
- unset -nocomplain ordertok
- }
- fix_reversal $p $a $v
- incr commitidx($v)
- if {$v == $curview} {
- set numcommits $commitidx($v)
- setcanvscroll
- if {[info exists targetid]} {
- if {![comes_before $targetid $p]} {
- incr targetrow
- }
+ readcommit $id
+ set vid $v,$id
+ set cmitlisted($vid) 1
+ set children($vid) {}
+ set parents($vid) [list $p]
+ set a [newvarc $v $id]
+ set varcid($vid) $a
+ lappend vshortids($v,[string range $id 0 3]) $id
+ if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] < 0} {
+ modify_arc $v $a
+ }
+ lappend varccommits($v,$a) $id
+ set vp $v,$p
+ if {[llength [lappend children($vp) $id]] > 1} {
+ set children($vp) [lsort -command [list vtokcmp $v] $children($vp)]
+ unset -nocomplain ordertok
+ }
+ fix_reversal $p $a $v
+ incr commitidx($v)
+ if {$v == $curview} {
+ set numcommits $commitidx($v)
+ setcanvscroll
+ if {[info exists targetid]} {
+ if {![comes_before $targetid $p]} {
+ incr targetrow
+ }
+ }
}
- }
}
proc insertfakerow {id p} {
- global varcid varccommits parents children cmitlisted
- global commitidx varctok vtokmod targetid targetrow curview numcommits
+ global varcid varccommits parents children cmitlisted
+ global commitidx varctok vtokmod targetid targetrow curview numcommits
- set v $curview
- set a $varcid($v,$p)
- set i [lsearch -exact $varccommits($v,$a) $p]
- if {$i < 0} {
- puts "oops: insertfakerow can't find [shortids $p] on arc $a"
- return
- }
- set children($v,$id) {}
- set parents($v,$id) [list $p]
- set varcid($v,$id) $a
- lappend children($v,$p) $id
- set cmitlisted($v,$id) 1
- set numcommits [incr commitidx($v)]
- # note we deliberately don't update varcstart($v) even if $i == 0
- set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
- modify_arc $v $a $i
- if {[info exists targetid]} {
- if {![comes_before $targetid $p]} {
- incr targetrow
+ set v $curview
+ set a $varcid($v,$p)
+ set i [lsearch -exact $varccommits($v,$a) $p]
+ if {$i < 0} {
+ puts "oops: insertfakerow can't find [shortids $p] on arc $a"
+ return
}
- }
- setcanvscroll
- drawvisible
+ set children($v,$id) {}
+ set parents($v,$id) [list $p]
+ set varcid($v,$id) $a
+ lappend children($v,$p) $id
+ set cmitlisted($v,$id) 1
+ set numcommits [incr commitidx($v)]
+ # note we deliberately don't update varcstart($v) even if $i == 0
+ set varccommits($v,$a) [linsert $varccommits($v,$a) $i $id]
+ modify_arc $v $a $i
+ if {[info exists targetid]} {
+ if {![comes_before $targetid $p]} {
+ incr targetrow
+ }
+ }
+ setcanvscroll
+ drawvisible
}
proc removefakerow {id} {
- global varcid varccommits parents children commitidx
- global varctok vtokmod cmitlisted currentid selectedline
- global targetid curview numcommits
+ global varcid varccommits parents children commitidx
+ global varctok vtokmod cmitlisted currentid selectedline
+ global targetid curview numcommits
- set v $curview
- if {[llength $parents($v,$id)] != 1} {
- puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
- return
- }
- set p [lindex $parents($v,$id) 0]
- set a $varcid($v,$id)
- set i [lsearch -exact $varccommits($v,$a) $id]
- if {$i < 0} {
- puts "oops: removefakerow can't find [shortids $id] on arc $a"
- return
- }
- unset varcid($v,$id)
- set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
- unset parents($v,$id)
- unset children($v,$id)
- unset cmitlisted($v,$id)
- set numcommits [incr commitidx($v) -1]
- set j [lsearch -exact $children($v,$p) $id]
- if {$j >= 0} {
- set children($v,$p) [lreplace $children($v,$p) $j $j]
- }
- modify_arc $v $a $i
- if {[info exist currentid] && $id eq $currentid} {
- unset currentid
- set selectedline {}
- }
- if {[info exists targetid] && $targetid eq $id} {
- set targetid $p
- }
- setcanvscroll
- drawvisible
+ set v $curview
+ if {[llength $parents($v,$id)] != 1} {
+ puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents"
+ return
+ }
+ set p [lindex $parents($v,$id) 0]
+ set a $varcid($v,$id)
+ set i [lsearch -exact $varccommits($v,$a) $id]
+ if {$i < 0} {
+ puts "oops: removefakerow can't find [shortids $id] on arc $a"
+ return
+ }
+ unset varcid($v,$id)
+ set varccommits($v,$a) [lreplace $varccommits($v,$a) $i $i]
+ unset parents($v,$id)
+ unset children($v,$id)
+ unset cmitlisted($v,$id)
+ set numcommits [incr commitidx($v) -1]
+ set j [lsearch -exact $children($v,$p) $id]
+ if {$j >= 0} {
+ set children($v,$p) [lreplace $children($v,$p) $j $j]
+ }
+ modify_arc $v $a $i
+ if {[info exist currentid] && $id eq $currentid} {
+ unset currentid
+ set selectedline {}
+ }
+ if {[info exists targetid] && $targetid eq $id} {
+ set targetid $p
+ }
+ setcanvscroll
+ drawvisible
}
proc real_children {vp} {
- global children nullid nullid2
+ global children nullid nullid2
- set kids {}
- foreach id $children($vp) {
- if {$id ne $nullid && $id ne $nullid2} {
- lappend kids $id
+ set kids {}
+ foreach id $children($vp) {
+ if {$id ne $nullid && $id ne $nullid2} {
+ lappend kids $id
+ }
}
- }
- return $kids
+ return $kids
}
proc first_real_child {vp} {
- global children nullid nullid2
+ global children nullid nullid2
- foreach id $children($vp) {
- if {$id ne $nullid && $id ne $nullid2} {
- return $id
+ foreach id $children($vp) {
+ if {$id ne $nullid && $id ne $nullid2} {
+ return $id
+ }
}
- }
- return {}
+ return {}
}
proc last_real_child {vp} {
- global children nullid nullid2
+ global children nullid nullid2
- set kids $children($vp)
- for {set i [llength $kids]} {[incr i -1] >= 0} {} {
- set id [lindex $kids $i]
- if {$id ne $nullid && $id ne $nullid2} {
- return $id
+ set kids $children($vp)
+ for {set i [llength $kids]} {[incr i -1] >= 0} {} {
+ set id [lindex $kids $i]
+ if {$id ne $nullid && $id ne $nullid2} {
+ return $id
+ }
}
- }
- return {}
+ return {}
}
proc vtokcmp {v a b} {
- global varctok varcid
+ global varctok varcid
- return [string compare [lindex $varctok($v) $varcid($v,$a)] \
- [lindex $varctok($v) $varcid($v,$b)]]
+ return [string compare [lindex $varctok($v) $varcid($v,$a)] \
+ [lindex $varctok($v) $varcid($v,$b)]]
}
# This assumes that if lim is not given, the caller has checked that
# arc a's token is less than $vtokmod($v)
proc modify_arc {v a {lim {}}} {
- global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
+ global varctok vtokmod varcmod varcrow vupptr curview vrowmod varccommits
- if {$lim ne {}} {
- set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
- if {$c > 0} return
- if {$c == 0} {
- set r [lindex $varcrow($v) $a]
- if {$r ne {} && $vrowmod($v) <= $r + $lim} return
+ if {$lim ne {}} {
+ set c [string compare [lindex $varctok($v) $a] $vtokmod($v)]
+ if {$c > 0} return
+ if {$c == 0} {
+ set r [lindex $varcrow($v) $a]
+ if {$r ne {} && $vrowmod($v) <= $r + $lim} return
+ }
}
- }
- set vtokmod($v) [lindex $varctok($v) $a]
- set varcmod($v) $a
- if {$v == $curview} {
- while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
- set a [lindex $vupptr($v) $a]
- set lim {}
+ set vtokmod($v) [lindex $varctok($v) $a]
+ set varcmod($v) $a
+ if {$v == $curview} {
+ while {$a != 0 && [lindex $varcrow($v) $a] eq {}} {
+ set a [lindex $vupptr($v) $a]
+ set lim {}
+ }
+ set r 0
+ if {$a != 0} {
+ if {$lim eq {}} {
+ set lim [llength $varccommits($v,$a)]
+ }
+ set r [expr {[lindex $varcrow($v) $a] + $lim}]
+ }
+ set vrowmod($v) $r
+ undolayout $r
}
- set r 0
- if {$a != 0} {
- if {$lim eq {}} {
- set lim [llength $varccommits($v,$a)]
- }
- set r [expr {[lindex $varcrow($v) $a] + $lim}]
- }
- set vrowmod($v) $r
- undolayout $r
- }
}
proc update_arcrows {v} {
- global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
- global varcid vrownum varcorder varcix varccommits
- global vupptr vdownptr vleftptr varctok
- global displayorder parentlist curview cached_commitrow
+ global vtokmod varcmod vrowmod varcrow commitidx currentid selectedline
+ global varcid vrownum varcorder varcix varccommits
+ global vupptr vdownptr vleftptr varctok
+ global displayorder parentlist curview cached_commitrow
- if {$vrowmod($v) == $commitidx($v)} return
- if {$v == $curview} {
- if {[llength $displayorder] > $vrowmod($v)} {
- set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
- set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
+ if {$vrowmod($v) == $commitidx($v)} return
+ if {$v == $curview} {
+ if {[llength $displayorder] > $vrowmod($v)} {
+ set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]]
+ set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]]
+ }
+ unset -nocomplain cached_commitrow
}
- unset -nocomplain cached_commitrow
- }
- set narctot [expr {[llength $varctok($v)] - 1}]
- set a $varcmod($v)
- while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
- # go up the tree until we find something that has a row number,
- # or we get to a seed
- set a [lindex $vupptr($v) $a]
- }
- if {$a == 0} {
- set a [lindex $vdownptr($v) 0]
- if {$a == 0} return
- set vrownum($v) {0}
- set varcorder($v) [list $a]
- lset varcix($v) $a 0
- lset varcrow($v) $a 0
- set arcn 0
- set row 0
- } else {
- set arcn [lindex $varcix($v) $a]
- if {[llength $vrownum($v)] > $arcn + 1} {
- set vrownum($v) [lrange $vrownum($v) 0 $arcn]
- set varcorder($v) [lrange $varcorder($v) 0 $arcn]
- }
- set row [lindex $varcrow($v) $a]
- }
- while {1} {
- set p $a
- incr row [llength $varccommits($v,$a)]
- # go down if possible
- set b [lindex $vdownptr($v) $a]
- if {$b == 0} {
- # if not, go left, or go up until we can go left
- while {$a != 0} {
- set b [lindex $vleftptr($v) $a]
- if {$b != 0} break
+ set narctot [expr {[llength $varctok($v)] - 1}]
+ set a $varcmod($v)
+ while {$a != 0 && [lindex $varcix($v) $a] eq {}} {
+ # go up the tree until we find something that has a row number,
+ # or we get to a seed
set a [lindex $vupptr($v) $a]
- }
- if {$a == 0} break
}
- set a $b
- incr arcn
- lappend vrownum($v) $row
- lappend varcorder($v) $a
- lset varcix($v) $a $arcn
- lset varcrow($v) $a $row
- }
- set vtokmod($v) [lindex $varctok($v) $p]
- set varcmod($v) $p
- set vrowmod($v) $row
- if {[info exists currentid]} {
- set selectedline [rowofcommit $currentid]
- }
+ if {$a == 0} {
+ set a [lindex $vdownptr($v) 0]
+ if {$a == 0} return
+ set vrownum($v) {0}
+ set varcorder($v) [list $a]
+ lset varcix($v) $a 0
+ lset varcrow($v) $a 0
+ set arcn 0
+ set row 0
+ } else {
+ set arcn [lindex $varcix($v) $a]
+ if {[llength $vrownum($v)] > $arcn + 1} {
+ set vrownum($v) [lrange $vrownum($v) 0 $arcn]
+ set varcorder($v) [lrange $varcorder($v) 0 $arcn]
+ }
+ set row [lindex $varcrow($v) $a]
+ }
+ while {1} {
+ set p $a
+ incr row [llength $varccommits($v,$a)]
+ # go down if possible
+ set b [lindex $vdownptr($v) $a]
+ if {$b == 0} {
+ # if not, go left, or go up until we can go left
+ while {$a != 0} {
+ set b [lindex $vleftptr($v) $a]
+ if {$b != 0} break
+ set a [lindex $vupptr($v) $a]
+ }
+ if {$a == 0} break
+ }
+ set a $b
+ incr arcn
+ lappend vrownum($v) $row
+ lappend varcorder($v) $a
+ lset varcix($v) $a $arcn
+ lset varcrow($v) $a $row
+ }
+ set vtokmod($v) [lindex $varctok($v) $p]
+ set varcmod($v) $p
+ set vrowmod($v) $row
+ if {[info exists currentid]} {
+ set selectedline [rowofcommit $currentid]
+ }
}
# Test whether view $v contains commit $id
proc commitinview {id v} {
- global varcid
+ global varcid
- return [info exists varcid($v,$id)]
+ return [info exists varcid($v,$id)]
}
# Return the row number for commit $id in the current view
proc rowofcommit {id} {
- global varcid varccommits varcrow curview cached_commitrow
- global varctok vtokmod
+ global varcid varccommits varcrow curview cached_commitrow
+ global varctok vtokmod
- set v $curview
- if {![info exists varcid($v,$id)]} {
- puts "oops rowofcommit no arc for [shortids $id]"
- return {}
- }
- set a $varcid($v,$id)
- if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
- update_arcrows $v
- }
- if {[info exists cached_commitrow($id)]} {
- return $cached_commitrow($id)
- }
- set i [lsearch -exact $varccommits($v,$a) $id]
- if {$i < 0} {
- puts "oops didn't find commit [shortids $id] in arc $a"
- return {}
- }
- incr i [lindex $varcrow($v) $a]
- set cached_commitrow($id) $i
- return $i
+ set v $curview
+ if {![info exists varcid($v,$id)]} {
+ puts "oops rowofcommit no arc for [shortids $id]"
+ return {}
+ }
+ set a $varcid($v,$id)
+ if {[string compare [lindex $varctok($v) $a] $vtokmod($v)] >= 0} {
+ update_arcrows $v
+ }
+ if {[info exists cached_commitrow($id)]} {
+ return $cached_commitrow($id)
+ }
+ set i [lsearch -exact $varccommits($v,$a) $id]
+ if {$i < 0} {
+ puts "oops didn't find commit [shortids $id] in arc $a"
+ return {}
+ }
+ incr i [lindex $varcrow($v) $a]
+ set cached_commitrow($id) $i
+ return $i
}
# Returns 1 if a is on an earlier row than b, otherwise 0
proc comes_before {a b} {
- global varcid varctok curview
+ global varcid varctok curview
- set v $curview
- if {$a eq $b || ![info exists varcid($v,$a)] || \
- ![info exists varcid($v,$b)]} {
- return 0
- }
- if {$varcid($v,$a) != $varcid($v,$b)} {
- return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
- [lindex $varctok($v) $varcid($v,$b)]] < 0}]
- }
- return [expr {[rowofcommit $a] < [rowofcommit $b]}]
+ set v $curview
+ if {$a eq $b || ![info exists varcid($v,$a)] || \
+ ![info exists varcid($v,$b)]} {
+ return 0
+ }
+ if {$varcid($v,$a) != $varcid($v,$b)} {
+ return [expr {[string compare [lindex $varctok($v) $varcid($v,$a)] \
+ [lindex $varctok($v) $varcid($v,$b)]] < 0}]
+ }
+ return [expr {[rowofcommit $a] < [rowofcommit $b]}]
}
proc bsearch {l elt} {
- if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
- return 0
- }
- set lo 0
- set hi [llength $l]
- while {$hi - $lo > 1} {
- set mid [expr {int(($lo + $hi) / 2)}]
- set t [lindex $l $mid]
- if {$elt < $t} {
- set hi $mid
- } elseif {$elt > $t} {
- set lo $mid
- } else {
- return $mid
+ if {[llength $l] == 0 || $elt <= [lindex $l 0]} {
+ return 0
}
- }
- return $lo
+ set lo 0
+ set hi [llength $l]
+ while {$hi - $lo > 1} {
+ set mid [expr {int(($lo + $hi) / 2)}]
+ set t [lindex $l $mid]
+ if {$elt < $t} {
+ set hi $mid
+ } elseif {$elt > $t} {
+ set lo $mid
+ } else {
+ return $mid
+ }
+ }
+ return $lo
}
# Make sure rows $start..$end-1 are valid in displayorder and parentlist
proc make_disporder {start end} {
- global vrownum curview commitidx displayorder parentlist
- global varccommits varcorder parents vrowmod varcrow
- global d_valid_start d_valid_end
+ global vrownum curview commitidx displayorder parentlist
+ global varccommits varcorder parents vrowmod varcrow
+ global d_valid_start d_valid_end
- if {$end > $vrowmod($curview)} {
- update_arcrows $curview
- }
- set ai [bsearch $vrownum($curview) $start]
- set start [lindex $vrownum($curview) $ai]
- set narc [llength $vrownum($curview)]
- for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
- set a [lindex $varcorder($curview) $ai]
- set l [llength $displayorder]
- set al [llength $varccommits($curview,$a)]
- if {$l < $r + $al} {
- if {$l < $r} {
- set pad [ntimes [expr {$r - $l}] {}]
- set displayorder [concat $displayorder $pad]
- set parentlist [concat $parentlist $pad]
- } elseif {$l > $r} {
- set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
- set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
- }
- foreach id $varccommits($curview,$a) {
- lappend displayorder $id
- lappend parentlist $parents($curview,$id)
- }
- } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
- set i $r
- foreach id $varccommits($curview,$a) {
- lset displayorder $i $id
- lset parentlist $i $parents($curview,$id)
- incr i
- }
+ if {$end > $vrowmod($curview)} {
+ update_arcrows $curview
+ }
+ set ai [bsearch $vrownum($curview) $start]
+ set start [lindex $vrownum($curview) $ai]
+ set narc [llength $vrownum($curview)]
+ for {set r $start} {$ai < $narc && $r < $end} {incr ai} {
+ set a [lindex $varcorder($curview) $ai]
+ set l [llength $displayorder]
+ set al [llength $varccommits($curview,$a)]
+ if {$l < $r + $al} {
+ if {$l < $r} {
+ set pad [ntimes [expr {$r - $l}] {}]
+ set displayorder [concat $displayorder $pad]
+ set parentlist [concat $parentlist $pad]
+ } elseif {$l > $r} {
+ set displayorder [lrange $displayorder 0 [expr {$r - 1}]]
+ set parentlist [lrange $parentlist 0 [expr {$r - 1}]]
+ }
+ foreach id $varccommits($curview,$a) {
+ lappend displayorder $id
+ lappend parentlist $parents($curview,$id)
+ }
+ } elseif {[lindex $displayorder [expr {$r + $al - 1}]] eq {}} {
+ set i $r
+ foreach id $varccommits($curview,$a) {
+ lset displayorder $i $id
+ lset parentlist $i $parents($curview,$id)
+ incr i
+ }
+ }
+ incr r $al
}
- incr r $al
- }
}
proc commitonrow {row} {
- global displayorder
+ global displayorder
- set id [lindex $displayorder $row]
- if {$id eq {}} {
- make_disporder $row [expr {$row + 1}]
set id [lindex $displayorder $row]
- }
- return $id
+ if {$id eq {}} {
+ make_disporder $row [expr {$row + 1}]
+ set id [lindex $displayorder $row]
+ }
+ return $id
}
proc closevarcs {v} {
- global varctok varccommits varcid parents children
- global cmitlisted commitidx vtokmod curview numcommits
+ global varctok varccommits varcid parents children
+ global cmitlisted commitidx vtokmod curview numcommits
- set missing_parents 0
- set scripts {}
- set narcs [llength $varctok($v)]
- for {set a 1} {$a < $narcs} {incr a} {
- set id [lindex $varccommits($v,$a) end]
- foreach p $parents($v,$id) {
- if {[info exists varcid($v,$p)]} continue
- # add p as a new commit
- incr missing_parents
- set cmitlisted($v,$p) 0
- set parents($v,$p) {}
- if {[llength $children($v,$p)] == 1 &&
- [llength $parents($v,$id)] == 1} {
- set b $a
- } else {
- set b [newvarc $v $p]
- }
- set varcid($v,$p) $b
- if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
- modify_arc $v $b
- }
- lappend varccommits($v,$b) $p
- incr commitidx($v)
- if {$v == $curview} {
- set numcommits $commitidx($v)
- }
- set scripts [check_interest $p $scripts]
+ set missing_parents 0
+ set scripts {}
+ set narcs [llength $varctok($v)]
+ for {set a 1} {$a < $narcs} {incr a} {
+ set id [lindex $varccommits($v,$a) end]
+ foreach p $parents($v,$id) {
+ if {[info exists varcid($v,$p)]} continue
+ # add p as a new commit
+ incr missing_parents
+ set cmitlisted($v,$p) 0
+ set parents($v,$p) {}
+ if {[llength $children($v,$p)] == 1 &&
+ [llength $parents($v,$id)] == 1} {
+ set b $a
+ } else {
+ set b [newvarc $v $p]
+ }
+ set varcid($v,$p) $b
+ if {[string compare [lindex $varctok($v) $b] $vtokmod($v)] < 0} {
+ modify_arc $v $b
+ }
+ lappend varccommits($v,$b) $p
+ incr commitidx($v)
+ if {$v == $curview} {
+ set numcommits $commitidx($v)
+ }
+ set scripts [check_interest $p $scripts]
+ }
}
- }
- if {$missing_parents > 0} {
- foreach s $scripts {
- eval $s
+ if {$missing_parents > 0} {
+ foreach s $scripts {
+ eval $s
+ }
}
- }
}
# Use $rwid as a substitute for $id, i.e. reparent $id's children to $rwid
# Assumes we already have an arc for $rwid.
proc rewrite_commit {v id rwid} {
- global children parents varcid varctok vtokmod varccommits
+ global children parents varcid varctok vtokmod varccommits
- foreach ch $children($v,$id) {
- # make $rwid be $ch's parent in place of $id
- set i [lsearch -exact $parents($v,$ch) $id]
- if {$i < 0} {
- puts "oops rewrite_commit didn't find $id in parent list for $ch"
+ foreach ch $children($v,$id) {
+ # make $rwid be $ch's parent in place of $id
+ set i [lsearch -exact $parents($v,$ch) $id]
+ if {$i < 0} {
+ puts "oops rewrite_commit didn't find $id in parent list for $ch"
+ }
+ set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
+ # add $ch to $rwid's children and sort the list if necessary
+ if {[llength [lappend children($v,$rwid) $ch]] > 1} {
+ set children($v,$rwid) [lsort -command [list vtokcmp $v] \
+ $children($v,$rwid)]
+ }
+ # fix the graph after joining $id to $rwid
+ set a $varcid($v,$ch)
+ fix_reversal $rwid $a $v
+ # parentlist is wrong for the last element of arc $a
+ # even if displayorder is right, hence the 3rd arg here
+ modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
}
- set parents($v,$ch) [lreplace $parents($v,$ch) $i $i $rwid]
- # add $ch to $rwid's children and sort the list if necessary
- if {[llength [lappend children($v,$rwid) $ch]] > 1} {
- set children($v,$rwid) [lsort -command [list vtokcmp $v] \
- $children($v,$rwid)]
- }
- # fix the graph after joining $id to $rwid
- set a $varcid($v,$ch)
- fix_reversal $rwid $a $v
- # parentlist is wrong for the last element of arc $a
- # even if displayorder is right, hence the 3rd arg here
- modify_arc $v $a [expr {[llength $varccommits($v,$a)] - 1}]
- }
}
# Mechanism for registering a command to be executed when we come
# across a particular commit. To handle the case when only the
# prefix of the commit is known, the commitinterest array is now
-# indexed by the first 4 characters of the ID. Each element is a
+# indexed by the first 4 characters of the ID. Each element is a
# list of id, cmd pairs.
proc interestedin {id cmd} {
- global commitinterest
+ global commitinterest
- lappend commitinterest([string range $id 0 3]) $id $cmd
+ lappend commitinterest([string range $id 0 3]) $id $cmd
}
proc check_interest {id scripts} {
- global commitinterest
+ global commitinterest
- set prefix [string range $id 0 3]
- if {[info exists commitinterest($prefix)]} {
- set newlist {}
- foreach {i script} $commitinterest($prefix) {
- if {[string match "$i*" $id]} {
- lappend scripts [string map [list "%I" $id "%P" $i] $script]
- } else {
- lappend newlist $i $script
- }
+ set prefix [string range $id 0 3]
+ if {[info exists commitinterest($prefix)]} {
+ set newlist {}
+ foreach {i script} $commitinterest($prefix) {
+ if {[string match "$i*" $id]} {
+ lappend scripts [string map [list "%I" $id "%P" $i] $script]
+ } else {
+ lappend newlist $i $script
+ }
+ }
+ if {$newlist ne {}} {
+ set commitinterest($prefix) $newlist
+ } else {
+ unset commitinterest($prefix)
+ }
}
- if {$newlist ne {}} {
- set commitinterest($prefix) $newlist
- } else {
- unset commitinterest($prefix)
- }
- }
- return $scripts
+ return $scripts
}
proc getcommitlines {fd inst view updating} {
- global cmitlisted leftover
- global commitidx commitdata vdatemode
- global parents children curview hlview
- global idpending ordertok
- global varccommits varcid varctok vtokmod vfilelimit vshortids
+ global cmitlisted leftover
+ global commitidx commitdata vdatemode
+ global parents children curview hlview
+ global idpending ordertok
+ global varccommits varcid varctok vtokmod vfilelimit vshortids
- set stuff [read $fd 500000]
- # git log doesn't terminate the last commit with a null...
- if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
- set stuff "\0"
- }
- if {$stuff == {}} {
- if {![eof $fd]} {
- return 1
+ set stuff [read $fd 500000]
+ # git log doesn't terminate the last commit with a null...
+ if {$stuff == {} && $leftover($inst) ne {} && [eof $fd]} {
+ set stuff "\0"
}
- global commfd viewcomplete viewactive viewname
- global viewinstances
- unset commfd($inst)
- set i [lsearch -exact $viewinstances($view) $inst]
- if {$i >= 0} {
- set viewinstances($view) [lreplace $viewinstances($view) $i $i]
- }
- # set it blocking so we wait for the process to terminate
- fconfigure $fd -blocking 1
- if {[catch {close $fd} err]} {
- set fv {}
- if {$view != $curview} {
- set fv " for the \"$viewname($view)\" view"
- }
- if {[string range $err 0 4] == "usage"} {
- set err "Gitk: error reading commits$fv:\
- bad arguments to git log."
- if {$viewname($view) eq [mc "Command line"]} {
- append err \
- " (Note: arguments to gitk are passed to git log\
- to allow selection of commits to be displayed.)"
+ if {$stuff == {}} {
+ if {![eof $fd]} {
+ return 1
}
- } else {
- set err "Error reading commits$fv: $err"
- }
- error_popup $err
- }
- if {[incr viewactive($view) -1] <= 0} {
- set viewcomplete($view) 1
- # Check if we have seen any ids listed as parents that haven't
- # appeared in the list
- closevarcs $view
- notbusy $view
- }
- if {$view == $curview} {
- run chewcommits
- }
- return 0
- }
- set start 0
- set gotsome 0
- set scripts {}
- while 1 {
- set i [string first "\0" $stuff $start]
- if {$i < 0} {
- append leftover($inst) [string range $stuff $start end]
- break
- }
- if {$start == 0} {
- set cmit $leftover($inst)
- append cmit [string range $stuff 0 [expr {$i - 1}]]
- set leftover($inst) {}
- } else {
- set cmit [string range $stuff $start [expr {$i - 1}]]
- }
- set start [expr {$i + 1}]
- set j [string first "\n" $cmit]
- set ok 0
- set listed 1
- if {$j >= 0 && [string match "commit *" $cmit]} {
- set ids [string range $cmit 7 [expr {$j - 1}]]
- if {[string match {[-^<>]*} $ids]} {
- switch -- [string index $ids 0] {
- "-" {set listed 0}
- "^" {set listed 2}
- "<" {set listed 3}
- ">" {set listed 4}
+ global commfd viewcomplete viewactive viewname
+ global viewinstances
+ unset commfd($inst)
+ set i [lsearch -exact $viewinstances($view) $inst]
+ if {$i >= 0} {
+ set viewinstances($view) [lreplace $viewinstances($view) $i $i]
}
- set ids [string range $ids 1 end]
- }
- set ok 1
- foreach id $ids {
- if {[string length $id] != 40} {
- set ok 0
- break
+ # set it blocking so we wait for the process to terminate
+ fconfigure $fd -blocking 1
+ if {[catch {close $fd} err]} {
+ set fv {}
+ if {$view != $curview} {
+ set fv " for the \"$viewname($view)\" view"
+ }
+ if {[string range $err 0 4] == "usage"} {
+ set err "Gitk: error reading commits$fv:\
+ bad arguments to git log."
+ if {$viewname($view) eq [mc "Command line"]} {
+ append err \
+ " (Note: arguments to gitk are passed to git log\
+ to allow selection of commits to be displayed.)"
+ }
+ } else {
+ set err "Error reading commits$fv: $err"
+ }
+ error_popup $err
}
- }
- }
- if {!$ok} {
- set shortcmit $cmit
- if {[string length $shortcmit] > 80} {
- set shortcmit "[string range $shortcmit 0 80]..."
- }
- error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
- exit 1
- }
- set id [lindex $ids 0]
- set vid $view,$id
-
- lappend vshortids($view,[string range $id 0 3]) $id
-
- if {!$listed && $updating && ![info exists varcid($vid)] &&
- $vfilelimit($view) ne {}} {
- # git log doesn't rewrite parents for unlisted commits
- # when doing path limiting, so work around that here
- # by working out the rewritten parent with git rev-list
- # and if we already know about it, using the rewritten
- # parent as a substitute parent for $id's children.
- if {![catch {
- set rwid [exec git rev-list --first-parent --max-count=1 \
- $id -- $vfilelimit($view)]
- }]} {
- if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
- # use $rwid in place of $id
- rewrite_commit $view $id $rwid
- continue
+ if {[incr viewactive($view) -1] <= 0} {
+ set viewcomplete($view) 1
+ # Check if we have seen any ids listed as parents that haven't
+ # appeared in the list
+ closevarcs $view
+ notbusy $view
}
- }
- }
-
- set a 0
- if {[info exists varcid($vid)]} {
- if {$cmitlisted($vid) || !$listed} continue
- set a $varcid($vid)
- }
- if {$listed} {
- set olds [lrange $ids 1 end]
- } else {
- set olds {}
- }
- set commitdata($id) [string range $cmit [expr {$j + 1}] end]
- set cmitlisted($vid) $listed
- set parents($vid) $olds
- if {![info exists children($vid)]} {
- set children($vid) {}
- } elseif {$a == 0 && [llength $children($vid)] == 1} {
- set k [lindex $children($vid) 0]
- if {[llength $parents($view,$k)] == 1 &&
- (!$vdatemode($view) ||
- $varcid($view,$k) == [llength $varctok($view)] - 1)} {
- set a $varcid($view,$k)
- }
- }
- if {$a == 0} {
- # new arc
- set a [newvarc $view $id]
- }
- if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
- modify_arc $view $a
- }
- if {![info exists varcid($vid)]} {
- set varcid($vid) $a
- lappend varccommits($view,$a) $id
- incr commitidx($view)
- }
-
- set i 0
- foreach p $olds {
- if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
- set vp $view,$p
- if {[llength [lappend children($vp) $id]] > 1 &&
- [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
- set children($vp) [lsort -command [list vtokcmp $view] \
- $children($vp)]
- unset -nocomplain ordertok
+ if {$view == $curview} {
+ run chewcommits
}
- if {[info exists varcid($view,$p)]} {
- fix_reversal $p $a $view
+ return 0
+ }
+ set start 0
+ set gotsome 0
+ set scripts {}
+ while 1 {
+ set i [string first "\0" $stuff $start]
+ if {$i < 0} {
+ append leftover($inst) [string range $stuff $start end]
+ break
}
- }
- incr i
- }
+ if {$start == 0} {
+ set cmit $leftover($inst)
+ append cmit [string range $stuff 0 [expr {$i - 1}]]
+ set leftover($inst) {}
+ } else {
+ set cmit [string range $stuff $start [expr {$i - 1}]]
+ }
+ set start [expr {$i + 1}]
+ set j [string first "\n" $cmit]
+ set ok 0
+ set listed 1
+ if {$j >= 0 && [string match "commit *" $cmit]} {
+ set ids [string range $cmit 7 [expr {$j - 1}]]
+ if {[string match {[-^<>]*} $ids]} {
+ switch -- [string index $ids 0] {
+ "-" {set listed 0}
+ "^" {set listed 2}
+ "<" {set listed 3}
+ ">" {set listed 4}
+ }
+ set ids [string range $ids 1 end]
+ }
+ set ok 1
+ foreach id $ids {
+ if {[string length $id] != 40} {
+ set ok 0
+ break
+ }
+ }
+ }
+ if {!$ok} {
+ set shortcmit $cmit
+ if {[string length $shortcmit] > 80} {
+ set shortcmit "[string range $shortcmit 0 80]..."
+ }
+ error_popup "[mc "Can't parse git log output:"] {$shortcmit}"
+ exit 1
+ }
+ set id [lindex $ids 0]
+ set vid $view,$id
- set scripts [check_interest $id $scripts]
- set gotsome 1
- }
- if {$gotsome} {
- global numcommits hlview
+ lappend vshortids($view,[string range $id 0 3]) $id
- if {$view == $curview} {
- set numcommits $commitidx($view)
- run chewcommits
+ if {!$listed && $updating && ![info exists varcid($vid)] &&
+ $vfilelimit($view) ne {}} {
+ # git log doesn't rewrite parents for unlisted commits
+ # when doing path limiting, so work around that here
+ # by working out the rewritten parent with git rev-list
+ # and if we already know about it, using the rewritten
+ # parent as a substitute parent for $id's children.
+ if {![catch {
+ set rwid [exec git rev-list --first-parent --max-count=1 \
+ $id -- $vfilelimit($view)]
+ }]} {
+ if {$rwid ne {} && [info exists varcid($view,$rwid)]} {
+ # use $rwid in place of $id
+ rewrite_commit $view $id $rwid
+ continue
+ }
+ }
+ }
+
+ set a 0
+ if {[info exists varcid($vid)]} {
+ if {$cmitlisted($vid) || !$listed} continue
+ set a $varcid($vid)
+ }
+ if {$listed} {
+ set olds [lrange $ids 1 end]
+ } else {
+ set olds {}
+ }
+ set commitdata($id) [string range $cmit [expr {$j + 1}] end]
+ set cmitlisted($vid) $listed
+ set parents($vid) $olds
+ if {![info exists children($vid)]} {
+ set children($vid) {}
+ } elseif {$a == 0 && [llength $children($vid)] == 1} {
+ set k [lindex $children($vid) 0]
+ if {[llength $parents($view,$k)] == 1 &&
+ (!$vdatemode($view) ||
+ $varcid($view,$k) == [llength $varctok($view)] - 1)} {
+ set a $varcid($view,$k)
+ }
+ }
+ if {$a == 0} {
+ # new arc
+ set a [newvarc $view $id]
+ }
+ if {[string compare [lindex $varctok($view) $a] $vtokmod($view)] < 0} {
+ modify_arc $view $a
+ }
+ if {![info exists varcid($vid)]} {
+ set varcid($vid) $a
+ lappend varccommits($view,$a) $id
+ incr commitidx($view)
+ }
+
+ set i 0
+ foreach p $olds {
+ if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
+ set vp $view,$p
+ if {[llength [lappend children($vp) $id]] > 1 &&
+ [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} {
+ set children($vp) [lsort -command [list vtokcmp $view] \
+ $children($vp)]
+ unset -nocomplain ordertok
+ }
+ if {[info exists varcid($view,$p)]} {
+ fix_reversal $p $a $view
+ }
+ }
+ incr i
+ }
+
+ set scripts [check_interest $id $scripts]
+ set gotsome 1
}
- if {[info exists hlview] && $view == $hlview} {
- # we never actually get here...
- run vhighlightmore
+ if {$gotsome} {
+ global numcommits hlview
+
+ if {$view == $curview} {
+ set numcommits $commitidx($view)
+ run chewcommits
+ }
+ if {[info exists hlview] && $view == $hlview} {
+ # we never actually get here...
+ run vhighlightmore
+ }
+ foreach s $scripts {
+ eval $s
+ }
}
- foreach s $scripts {
- eval $s
- }
- }
- return 2
+ return 2
}
proc chewcommits {} {
- global curview hlview viewcomplete
- global pending_select
+ global curview hlview viewcomplete
+ global pending_select
- layoutmore
- if {$viewcomplete($curview)} {
- global commitidx varctok
- global numcommits startmsecs
+ layoutmore
+ if {$viewcomplete($curview)} {
+ global commitidx varctok
+ global numcommits startmsecs
- if {[info exists pending_select]} {
- update
- reset_pending_select {}
+ if {[info exists pending_select]} {
+ update
+ reset_pending_select {}
- if {[commitinview $pending_select $curview]} {
- selectline [rowofcommit $pending_select] 1
- } else {
- set row [first_real_row]
- selectline $row 1
- }
+ if {[commitinview $pending_select $curview]} {
+ selectline [rowofcommit $pending_select] 1
+ } else {
+ set row [first_real_row]
+ selectline $row 1
+ }
+ }
+ if {$commitidx($curview) > 0} {
+ #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
+ #puts "overall $ms ms for $numcommits commits"
+ #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
+ } else {
+ show_status [mc "No commits selected"]
+ }
+ notbusy layout
}
- if {$commitidx($curview) > 0} {
- #set ms [expr {[clock clicks -milliseconds] - $startmsecs}]
- #puts "overall $ms ms for $numcommits commits"
- #puts "[llength $varctok($view)] arcs, $commitidx($view) commits"
- } else {
- show_status [mc "No commits selected"]
- }
- notbusy layout
- }
- return 0
+ return 0
}
proc do_readcommit {id} {
- global tclencoding
+ global tclencoding
- # Invoke git-log to handle automatic encoding conversion
- set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
- # Read the results using i18n.logoutputencoding
- fconfigure $fd -translation lf -eofchar {}
- if {$tclencoding != {}} {
- fconfigure $fd -encoding $tclencoding
- }
- set contents [read $fd]
- close $fd
- # Remove the heading line
- regsub {^commit [0-9a-f]+\n} $contents {} contents
+ # Invoke git-log to handle automatic encoding conversion
+ set fd [open [concat | git log --no-color --pretty=raw -1 $id] r]
+ # Read the results using i18n.logoutputencoding
+ fconfigure $fd -translation lf -eofchar {}
+ if {$tclencoding != {}} {
+ fconfigure $fd -encoding $tclencoding
+ }
+ set contents [read $fd]
+ close $fd
+ # Remove the heading line
+ regsub {^commit [0-9a-f]+\n} $contents {} contents
- return $contents
+ return $contents
}
proc readcommit {id} {
- if {[catch {set contents [do_readcommit $id]}]} return
- parsecommit $id $contents 1
+ if {[catch {set contents [do_readcommit $id]}]} return
+ parsecommit $id $contents 1
}
proc parsecommit {id contents listed} {
- global commitinfo
+ global commitinfo
- set inhdr 1
- set comment {}
- set headline {}
- set auname {}
- set audate {}
- set comname {}
- set comdate {}
- set hdrend [string first "\n\n" $contents]
- if {$hdrend < 0} {
- # should never happen...
- set hdrend [string length $contents]
- }
- set header [string range $contents 0 [expr {$hdrend - 1}]]
- set comment [string range $contents [expr {$hdrend + 2}] end]
- foreach line [split $header "\n"] {
- set line [split $line " "]
- set tag [lindex $line 0]
- if {$tag == "author"} {
- set audate [lrange $line end-1 end]
- set auname [join [lrange $line 1 end-2] " "]
- } elseif {$tag == "committer"} {
- set comdate [lrange $line end-1 end]
- set comname [join [lrange $line 1 end-2] " "]
+ set inhdr 1
+ set comment {}
+ set headline {}
+ set auname {}
+ set audate {}
+ set comname {}
+ set comdate {}
+ set hdrend [string first "\n\n" $contents]
+ if {$hdrend < 0} {
+ # should never happen...
+ set hdrend [string length $contents]
}
- }
- set headline {}
- # take the first non-blank line of the comment as the headline
- set headline [string trimleft $comment]
- set i [string first "\n" $headline]
- if {$i >= 0} {
- set headline [string range $headline 0 $i]
- }
- set headline [string trimright $headline]
- set i [string first "\r" $headline]
- if {$i >= 0} {
- set headline [string trimright [string range $headline 0 $i]]
- }
- if {!$listed} {
- # git log indents the comment by 4 spaces;
- # if we got this via git cat-file, add the indentation
- set newcomment {}
- foreach line [split $comment "\n"] {
- append newcomment " "
- append newcomment $line
- append newcomment "\n"
+ set header [string range $contents 0 [expr {$hdrend - 1}]]
+ set comment [string range $contents [expr {$hdrend + 2}] end]
+ foreach line [split $header "\n"] {
+ set line [split $line " "]
+ set tag [lindex $line 0]
+ if {$tag == "author"} {
+ set audate [lrange $line end-1 end]
+ set auname [join [lrange $line 1 end-2] " "]
+ } elseif {$tag == "committer"} {
+ set comdate [lrange $line end-1 end]
+ set comname [join [lrange $line 1 end-2] " "]
+ }
}
- set comment $newcomment
- }
- set hasnote [string first "\nNotes:\n" $contents]
- set diff ""
- # If there is diff output shown in the git-log stream, split it
- # out. But get rid of the empty line that always precedes the
- # diff.
- set i [string first "\n\ndiff" $comment]
- if {$i >= 0} {
- set diff [string range $comment $i+1 end]
- set comment [string range $comment 0 $i-1]
- }
- set commitinfo($id) [list $headline $auname $audate \
- $comname $comdate $comment $hasnote $diff]
+ set headline {}
+ # take the first non-blank line of the comment as the headline
+ set headline [string trimleft $comment]
+ set i [string first "\n" $headline]
+ if {$i >= 0} {
+ set headline [string range $headline 0 $i]
+ }
+ set headline [string trimright $headline]
+ set i [string first "\r" $headline]
+ if {$i >= 0} {
+ set headline [string trimright [string range $headline 0 $i]]
+ }
+ if {!$listed} {
+ # git log indents the comment by 4 spaces;
+ # if we got this via git cat-file, add the indentation
+ set newcomment {}
+ foreach line [split $comment "\n"] {
+ append newcomment " "
+ append newcomment $line
+ append newcomment "\n"
+ }
+ set comment $newcomment
+ }
+ set hasnote [string first "\nNotes:\n" $contents]
+ set diff ""
+ # If there is diff output shown in the git-log stream, split it
+ # out. But get rid of the empty line that always precedes the
+ # diff.
+ set i [string first "\n\ndiff" $comment]
+ if {$i >= 0} {
+ set diff [string range $comment $i+1 end]
+ set comment [string range $comment 0 $i-1]
+ }
+ set commitinfo($id) [list $headline $auname $audate \
+ $comname $comdate $comment $hasnote $diff]
}
proc getcommit {id} {
- global commitdata commitinfo
+ global commitdata commitinfo
- if {[info exists commitdata($id)]} {
- parsecommit $id $commitdata($id) 1
- } else {
- readcommit $id
- if {![info exists commitinfo($id)]} {
- set commitinfo($id) [list [mc "No commit information available"]]
+ if {[info exists commitdata($id)]} {
+ parsecommit $id $commitdata($id) 1
+ } else {
+ readcommit $id
+ if {![info exists commitinfo($id)]} {
+ set commitinfo($id) [list [mc "No commit information available"]]
+ }
}
- }
- return 1
+ return 1
}
# Expand an abbreviated commit ID to a list of full 40-char IDs that match
# and are present in the current view.
# This is fairly slow...
proc longid {prefix} {
- global varcid curview vshortids
+ global varcid curview vshortids
- set ids {}
- if {[string length $prefix] >= 4} {
- set vshortid $curview,[string range $prefix 0 3]
- if {[info exists vshortids($vshortid)]} {
- foreach id $vshortids($vshortid) {
- if {[string match "$prefix*" $id]} {
- if {[lsearch -exact $ids $id] < 0} {
- lappend ids $id
- if {[llength $ids] >= 2} break
- }
+ set ids {}
+ if {[string length $prefix] >= 4} {
+ set vshortid $curview,[string range $prefix 0 3]
+ if {[info exists vshortids($vshortid)]} {
+ foreach id $vshortids($vshortid) {
+ if {[string match "$prefix*" $id]} {
+ if {[lsearch -exact $ids $id] < 0} {
+ lappend ids $id
+ if {[llength $ids] >= 2} break
+ }
+ }
+ }
+ }
+ } else {
+ foreach match [array names varcid "$curview,$prefix*"] {
+ lappend ids [lindex [split $match ","] 1]
+ if {[llength $ids] >= 2} break
}
- }
}
- } else {
- foreach match [array names varcid "$curview,$prefix*"] {
- lappend ids [lindex [split $match ","] 1]
- if {[llength $ids] >= 2} break
- }
- }
- return $ids
+ return $ids
}
proc readrefs {} {
- global tagids idtags headids idheads tagobjid
- global otherrefids idotherrefs mainhead mainheadid
- global selecthead selectheadid
- global hideremotes
- global tclencoding
+ global tagids idtags headids idheads tagobjid
+ global otherrefids idotherrefs mainhead mainheadid
+ global selecthead selectheadid
+ global hideremotes
+ global tclencoding
- foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
- unset -nocomplain $v
- }
- set refd [open [list | git show-ref -d] r]
- if {$tclencoding != {}} {
- fconfigure $refd -encoding $tclencoding
- }
- while {[gets $refd line] >= 0} {
- if {[string index $line 40] ne " "} continue
- set id [string range $line 0 39]
- set ref [string range $line 41 end]
- if {![string match "refs/*" $ref]} continue
- set name [string range $ref 5 end]
- if {[string match "remotes/*" $name]} {
- if {![string match "*/HEAD" $name] && !$hideremotes} {
- set headids($name) $id
- lappend idheads($id) $name
- }
- } elseif {[string match "heads/*" $name]} {
- set name [string range $name 6 end]
- set headids($name) $id
- lappend idheads($id) $name
- } elseif {[string match "tags/*" $name]} {
- # this lets refs/tags/foo^{} overwrite refs/tags/foo,
- # which is what we want since the former is the commit ID
- set name [string range $name 5 end]
- if {[string match "*^{}" $name]} {
- set name [string range $name 0 end-3]
- } else {
- set tagobjid($name) $id
- }
- set tagids($name) $id
- lappend idtags($id) $name
- } else {
- set otherrefids($name) $id
- lappend idotherrefs($id) $name
+ foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
+ unset -nocomplain $v
}
- }
- catch {close $refd}
- set mainhead {}
- set mainheadid {}
- catch {
- set mainheadid [exec git rev-parse HEAD]
- set thehead [exec git symbolic-ref HEAD]
- if {[string match "refs/heads/*" $thehead]} {
- set mainhead [string range $thehead 11 end]
+ set refd [open [list | git show-ref -d] r]
+ if {$tclencoding != {}} {
+ fconfigure $refd -encoding $tclencoding
}
- }
- set selectheadid {}
- if {$selecthead ne {}} {
+ while {[gets $refd line] >= 0} {
+ if {[string index $line 40] ne " "} continue
+ set id [string range $line 0 39]
+ set ref [string range $line 41 end]
+ if {![string match "refs/*" $ref]} continue
+ set name [string range $ref 5 end]
+ if {[string match "remotes/*" $name]} {
+ if {![string match "*/HEAD" $name] && !$hideremotes} {
+ set headids($name) $id
+ lappend idheads($id) $name
+ }
+ } elseif {[string match "heads/*" $name]} {
+ set name [string range $name 6 end]
+ set headids($name) $id
+ lappend idheads($id) $name
+ } elseif {[string match "tags/*" $name]} {
+ # this lets refs/tags/foo^{} overwrite refs/tags/foo,
+ # which is what we want since the former is the commit ID
+ set name [string range $name 5 end]
+ if {[string match "*^{}" $name]} {
+ set name [string range $name 0 end-3]
+ } else {
+ set tagobjid($name) $id
+ }
+ set tagids($name) $id
+ lappend idtags($id) $name
+ } else {
+ set otherrefids($name) $id
+ lappend idotherrefs($id) $name
+ }
+ }
+ catch {close $refd}
+ set mainhead {}
+ set mainheadid {}
catch {
- set selectheadid [exec git rev-parse --verify $selecthead]
+ set mainheadid [exec git rev-parse HEAD]
+ set thehead [exec git symbolic-ref HEAD]
+ if {[string match "refs/heads/*" $thehead]} {
+ set mainhead [string range $thehead 11 end]
+ }
+ }
+ set selectheadid {}
+ if {$selecthead ne {}} {
+ catch {
+ set selectheadid [exec git rev-parse --verify $selecthead]
+ }
}
- }
}
# skip over fake commits
proc first_real_row {} {
- global nullid nullid2 numcommits
+ global nullid nullid2 numcommits
- for {set row 0} {$row < $numcommits} {incr row} {
- set id [commitonrow $row]
- if {$id ne $nullid && $id ne $nullid2} {
- break
+ for {set row 0} {$row < $numcommits} {incr row} {
+ set id [commitonrow $row]
+ if {$id ne $nullid && $id ne $nullid2} {
+ break
+ }
}
- }
- return $row
+ return $row
}
# update things for a head moved to a child of its previous location
proc movehead {id name} {
- global headids idheads
+ global headids idheads
- removehead $headids($name) $name
- set headids($name) $id
- lappend idheads($id) $name
+ removehead $headids($name) $name
+ set headids($name) $id
+ lappend idheads($id) $name
}
# update things when a head has been removed
proc removehead {id name} {
- global headids idheads
+ global headids idheads
- if {$idheads($id) eq $name} {
- unset idheads($id)
- } else {
- set i [lsearch -exact $idheads($id) $name]
- if {$i >= 0} {
- set idheads($id) [lreplace $idheads($id) $i $i]
+ if {$idheads($id) eq $name} {
+ unset idheads($id)
+ } else {
+ set i [lsearch -exact $idheads($id) $name]
+ if {$i >= 0} {
+ set idheads($id) [lreplace $idheads($id) $i $i]
+ }
}
- }
- unset headids($name)
+ unset headids($name)
}
proc ttk_toplevel {w args} {
- global use_ttk
- eval [linsert $args 0 ::toplevel $w]
- if {$use_ttk} {
- place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
- }
- return $w
+ global use_ttk
+ eval [linsert $args 0 ::toplevel $w]
+ if {$use_ttk} {
+ place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1
+ }
+ return $w
}
proc make_transient {window origin} {
- global have_tk85
+ global have_tk85
- # In MacOS Tk 8.4 transient appears to work by setting
- # overrideredirect, which is utterly useless, since the
- # windows get no border, and are not even kept above
- # the parent.
- if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
+ # In MacOS Tk 8.4 transient appears to work by setting
+ # overrideredirect, which is utterly useless, since the
+ # windows get no border, and are not even kept above
+ # the parent.
+ if {!$have_tk85 && [tk windowingsystem] eq {aqua}} return
- wm transient $window $origin
+ wm transient $window $origin
- # Windows fails to place transient windows normally, so
- # schedule a callback to center them on the parent.
- if {[tk windowingsystem] eq {win32}} {
- after idle [list tk::PlaceWindow $window widget $origin]
- }
+ # Windows fails to place transient windows normally, so
+ # schedule a callback to center them on the parent.
+ if {[tk windowingsystem] eq {win32}} {
+ after idle [list tk::PlaceWindow $window widget $origin]
+ }
}
proc show_error {w top msg} {
- global NS
- if {![info exists NS]} {set NS ""}
- if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
- message $w.m -text $msg -justify center -aspect 400
- pack $w.m -side top -fill x -padx 20 -pady 20
- ${NS}::button $w.ok -default active -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"
- bind $top <Key-space> "destroy $top"
- bind $top <Key-Escape> "destroy $top"
- tkwait window $top
+ global NS
+ if {![info exists NS]} {set NS ""}
+ if {[wm state $top] eq "withdrawn"} { wm deiconify $top }
+ message $w.m -text $msg -justify center -aspect 400
+ pack $w.m -side top -fill x -padx 20 -pady 20
+ ${NS}::button $w.ok -default active -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"
+ bind $top <Key-space> "destroy $top"
+ bind $top <Key-Escape> "destroy $top"
+ tkwait window $top
}
proc error_popup {msg {owner .}} {
- if {[tk windowingsystem] eq "win32"} {
- tk_messageBox -icon error -type ok -title [wm title .] \
- -parent $owner -message $msg
- } else {
- set w .error
- ttk_toplevel $w
- make_transient $w $owner
- show_error $w $w $msg
- }
+ if {[tk windowingsystem] eq "win32"} {
+ tk_messageBox -icon error -type ok -title [wm title .] \
+ -parent $owner -message $msg
+ } else {
+ set w .error
+ ttk_toplevel $w
+ make_transient $w $owner
+ show_error $w $w $msg
+ }
}
proc confirm_popup {msg {owner .}} {
- global confirm_ok NS
- set confirm_ok 0
- set w .confirm
- ttk_toplevel $w
- make_transient $w $owner
- message $w.m -text $msg -justify center -aspect 400
- pack $w.m -side top -fill x -padx 20 -pady 20
- ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
- pack $w.ok -side left -fill x
- ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
- pack $w.cancel -side right -fill x
- bind $w <Visibility> "grab $w; focus $w"
- bind $w <Key-Return> "set confirm_ok 1; destroy $w"
- bind $w <Key-space> "set confirm_ok 1; destroy $w"
- bind $w <Key-Escape> "destroy $w"
- tk::PlaceWindow $w widget $owner
- tkwait window $w
- return $confirm_ok
+ global confirm_ok NS
+ set confirm_ok 0
+ set w .confirm
+ ttk_toplevel $w
+ make_transient $w $owner
+ message $w.m -text $msg -justify center -aspect 400
+ pack $w.m -side top -fill x -padx 20 -pady 20
+ ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w"
+ pack $w.ok -side left -fill x
+ ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w"
+ pack $w.cancel -side right -fill x
+ bind $w <Visibility> "grab $w; focus $w"
+ bind $w <Key-Return> "set confirm_ok 1; destroy $w"
+ bind $w <Key-space> "set confirm_ok 1; destroy $w"
+ bind $w <Key-Escape> "destroy $w"
+ tk::PlaceWindow $w widget $owner
+ tkwait window $w
+ return $confirm_ok
}
proc setoptions {} {
- global use_ttk
+ global use_ttk
- if {[tk windowingsystem] ne "win32"} {
- option add *Panedwindow.showHandle 1 startupFile
- option add *Panedwindow.sashRelief raised startupFile
- if {[tk windowingsystem] ne "aqua"} {
- option add *Menu.font uifont startupFile
- }
- } else {
- option add *Menu.TearOff 0 startupFile
- }
- option add *Button.font uifont startupFile
- option add *Checkbutton.font uifont startupFile
- option add *Radiobutton.font uifont startupFile
- option add *Menubutton.font uifont startupFile
- option add *Label.font uifont startupFile
- option add *Message.font uifont startupFile
- option add *Entry.font textfont startupFile
- option add *Text.font textfont startupFile
- option add *Labelframe.font uifont startupFile
- option add *Spinbox.font textfont startupFile
- option add *Listbox.font mainfont startupFile
+ if {[tk windowingsystem] ne "win32"} {
+ option add *Panedwindow.showHandle 1 startupFile
+ option add *Panedwindow.sashRelief raised startupFile
+ if {[tk windowingsystem] ne "aqua"} {
+ option add *Menu.font uifont startupFile
+ }
+ } else {
+ option add *Menu.TearOff 0 startupFile
+ }
+ option add *Button.font uifont startupFile
+ option add *Checkbutton.font uifont startupFile
+ option add *Radiobutton.font uifont startupFile
+ option add *Menubutton.font uifont startupFile
+ option add *Label.font uifont startupFile
+ option add *Message.font uifont startupFile
+ option add *Entry.font textfont startupFile
+ option add *Text.font textfont startupFile
+ option add *Labelframe.font uifont startupFile
+ option add *Spinbox.font textfont startupFile
+ option add *Listbox.font mainfont startupFile
}
proc setttkstyle {} {
- eval font configure TkDefaultFont [fontflags mainfont]
- eval font configure TkTextFont [fontflags textfont]
- eval font configure TkHeadingFont [fontflags mainfont]
- eval font configure TkCaptionFont [fontflags mainfont] -weight bold
- eval font configure TkTooltipFont [fontflags uifont]
- eval font configure TkFixedFont [fontflags textfont]
- eval font configure TkIconFont [fontflags uifont]
- eval font configure TkMenuFont [fontflags uifont]
- eval font configure TkSmallCaptionFont [fontflags uifont]
+ eval font configure TkDefaultFont [fontflags mainfont]
+ eval font configure TkTextFont [fontflags textfont]
+ eval font configure TkHeadingFont [fontflags mainfont]
+ eval font configure TkCaptionFont [fontflags mainfont] -weight bold
+ eval font configure TkTooltipFont [fontflags uifont]
+ eval font configure TkFixedFont [fontflags textfont]
+ eval font configure TkIconFont [fontflags uifont]
+ eval font configure TkMenuFont [fontflags uifont]
+ eval font configure TkSmallCaptionFont [fontflags uifont]
}
# Make a menu and submenus.
@@ -1996,8235 +1996,8235 @@ proc setttkstyle {} {
# description depends on type; it's the sublist for cascade, the
# command to invoke for command, or {variable value} for radiobutton
proc makemenu {m items} {
- menu $m
- if {[tk windowingsystem] eq {aqua}} {
- set Meta1 Cmd
- } else {
- set Meta1 Ctrl
- }
- foreach i $items {
- set name [mc [lindex $i 1]]
- set type [lindex $i 2]
- set thing [lindex $i 3]
- set params [list $type]
- if {$name ne {}} {
- set u [string first "&" [string map {&& x} $name]]
- lappend params -label [string map {&& & & {}} $name]
- if {$u >= 0} {
- lappend params -underline $u
- }
+ menu $m
+ if {[tk windowingsystem] eq {aqua}} {
+ set Meta1 Cmd
+ } else {
+ set Meta1 Ctrl
}
- switch -- $type {
- "cascade" {
- set submenu [string tolower [string map {& ""} [lindex $i 1]]]
- lappend params -menu $m.$submenu
- }
- "command" {
- lappend params -command $thing
- }
- "radiobutton" {
- lappend params -variable [lindex $thing 0] \
- -value [lindex $thing 1]
- }
+ foreach i $items {
+ set name [mc [lindex $i 1]]
+ set type [lindex $i 2]
+ set thing [lindex $i 3]
+ set params [list $type]
+ if {$name ne {}} {
+ set u [string first "&" [string map {&& x} $name]]
+ lappend params -label [string map {&& & & {}} $name]
+ if {$u >= 0} {
+ lappend params -underline $u
+ }
+ }
+ switch -- $type {
+ "cascade" {
+ set submenu [string tolower [string map {& ""} [lindex $i 1]]]
+ lappend params -menu $m.$submenu
+ }
+ "command" {
+ lappend params -command $thing
+ }
+ "radiobutton" {
+ lappend params -variable [lindex $thing 0] \
+ -value [lindex $thing 1]
+ }
+ }
+ set tail [lrange $i 4 end]
+ regsub -all {\yMeta1\y} $tail $Meta1 tail
+ eval $m add $params $tail
+ if {$type eq "cascade"} {
+ makemenu $m.$submenu $thing
+ }
}
- set tail [lrange $i 4 end]
- regsub -all {\yMeta1\y} $tail $Meta1 tail
- eval $m add $params $tail
- if {$type eq "cascade"} {
- makemenu $m.$submenu $thing
- }
- }
}
# translate string and remove ampersands
proc mca {str} {
- return [string map {&& & & {}} [mc $str]]
+ return [string map {&& & & {}} [mc $str]]
}
proc cleardropsel {w} {
- $w selection clear
+ $w selection clear
}
proc makedroplist {w varname args} {
- global use_ttk
- if {$use_ttk} {
- set width 0
- foreach label $args {
- set cx [string length $label]
- if {$cx > $width} {set width $cx}
- }
- set gm [ttk::combobox $w -width $width -state readonly\
- -textvariable $varname -values $args \
- -exportselection false]
- bind $gm <<ComboboxSelected>> [list $gm selection clear]
- } else {
- set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
- }
- return $gm
+ global use_ttk
+ if {$use_ttk} {
+ set width 0
+ foreach label $args {
+ set cx [string length $label]
+ if {$cx > $width} {set width $cx}
+ }
+ set gm [ttk::combobox $w -width $width -state readonly\
+ -textvariable $varname -values $args \
+ -exportselection false]
+ bind $gm <<ComboboxSelected>> [list $gm selection clear]
+ } else {
+ set gm [eval [linsert $args 0 tk_optionMenu $w $varname]]
+ }
+ return $gm
}
proc makewindow {} {
- global canv canv2 canv3 linespc charspc ctext cflist cscroll
- global tabstop
- global findtype findtypemenu findloc findstring fstring geometry
- global entries sha1entry sha1string sha1but
- global diffcontextstring diffcontext
- global ignorespace
- global maincursor textcursor curtextcursor
- global rowctxmenu fakerowmenu mergemax wrapcomment
- global highlight_files gdttype
- global searchstring sstring
- global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
- global uifgcolor uifgdisabledcolor
- global filesepbgcolor filesepfgcolor
- global mergecolors foundbgcolor currentsearchhitbgcolor
- global headctxmenu progresscanv progressitem progresscoords statusw
- global fprogitem fprogcoord lastprogupdate progupdatepending
- global rprogitem rprogcoord rownumsel numcommits
- global have_tk85 use_ttk NS
- global git_version
- global worddiff
+ global canv canv2 canv3 linespc charspc ctext cflist cscroll
+ global tabstop
+ global findtype findtypemenu findloc findstring fstring geometry
+ global entries sha1entry sha1string sha1but
+ global diffcontextstring diffcontext
+ global ignorespace
+ global maincursor textcursor curtextcursor
+ global rowctxmenu fakerowmenu mergemax wrapcomment
+ global highlight_files gdttype
+ global searchstring sstring
+ global bgcolor fgcolor bglist fglist diffcolors selectbgcolor
+ global uifgcolor uifgdisabledcolor
+ global filesepbgcolor filesepfgcolor
+ global mergecolors foundbgcolor currentsearchhitbgcolor
+ global headctxmenu progresscanv progressitem progresscoords statusw
+ global fprogitem fprogcoord lastprogupdate progupdatepending
+ global rprogitem rprogcoord rownumsel numcommits
+ global have_tk85 use_ttk NS
+ global git_version
+ global worddiff
- # The "mc" arguments here are purely so that xgettext
- # sees the following string as needing to be translated
- set file {
- mc "&File" cascade {
- {mc "&Update" command updatecommits -accelerator F5}
- {mc "&Reload" command reloadcommits -accelerator Shift-F5}
- {mc "Reread re&ferences" command rereadrefs}
- {mc "&List references" command showrefs -accelerator F2}
- {xx "" separator}
- {mc "Start git &gui" command {exec git gui &}}
- {xx "" separator}
- {mc "&Quit" command doquit -accelerator Meta1-Q}
- }}
- set edit {
- mc "&Edit" cascade {
- {mc "&Preferences" command doprefs}
- }}
- set view {
- mc "&View" cascade {
- {mc "&New view..." command {newview 0} -accelerator Shift-F4}
- {mc "&Edit view..." command editview -state disabled -accelerator F4}
- {mc "&Delete view" command delview -state disabled}
- {xx "" separator}
- {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
- }}
- if {[tk windowingsystem] ne "aqua"} {
- set help {
- mc "&Help" cascade {
- {mc "&About gitk" command about}
- {mc "&Key bindings" command keys}
- }}
- set bar [list $file $edit $view $help]
- } else {
- proc ::tk::mac::ShowPreferences {} {doprefs}
- proc ::tk::mac::Quit {} {doquit}
- lset file end [lreplace [lindex $file end] end-1 end]
- set apple {
- xx "&Apple" cascade {
- {mc "&About gitk" command about}
- {xx "" separator}
- }}
- set help {
- mc "&Help" cascade {
- {mc "&Key bindings" command keys}
- }}
- set bar [list $apple $file $view $help]
- }
- makemenu .bar $bar
- . configure -menu .bar
-
- if {$use_ttk} {
- # cover the non-themed toplevel with a themed frame.
- place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
- }
-
- # the gui has upper and lower half, parts of a paned window.
- ${NS}::panedwindow .ctop -orient vertical
-
- # possibly use assumed geometry
- if {![info exists geometry(pwsash0)]} {
- set geometry(topheight) [expr {15 * $linespc}]
- set geometry(topwidth) [expr {80 * $charspc}]
- set geometry(botheight) [expr {15 * $linespc}]
- set geometry(botwidth) [expr {50 * $charspc}]
- set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
- set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
- }
-
- # the upper half will have a paned window, a scroll bar to the right, and some stuff below
- ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
- ${NS}::frame .tf.histframe
- ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
- if {!$use_ttk} {
- .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
- }
-
- # create three canvases
- set cscroll .tf.histframe.csb
- set canv .tf.histframe.pwclist.canv
- canvas $canv \
- -selectbackground $selectbgcolor \
- -background $bgcolor -bd 0 \
- -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
- .tf.histframe.pwclist add $canv
- set canv2 .tf.histframe.pwclist.canv2
- canvas $canv2 \
- -selectbackground $selectbgcolor \
- -background $bgcolor -bd 0 -yscrollincr $linespc
- .tf.histframe.pwclist add $canv2
- set canv3 .tf.histframe.pwclist.canv3
- canvas $canv3 \
- -selectbackground $selectbgcolor \
- -background $bgcolor -bd 0 -yscrollincr $linespc
- .tf.histframe.pwclist add $canv3
- if {$use_ttk} {
- bind .tf.histframe.pwclist <Map> {
- bind %W <Map> {}
- .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
- .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
+ # The "mc" arguments here are purely so that xgettext
+ # sees the following string as needing to be translated
+ set file {
+ mc "&File" cascade {
+ {mc "&Update" command updatecommits -accelerator F5}
+ {mc "&Reload" command reloadcommits -accelerator Shift-F5}
+ {mc "Reread re&ferences" command rereadrefs}
+ {mc "&List references" command showrefs -accelerator F2}
+ {xx "" separator}
+ {mc "Start git &gui" command {exec git gui &}}
+ {xx "" separator}
+ {mc "&Quit" command doquit -accelerator Meta1-Q}
+ }}
+ set edit {
+ mc "&Edit" cascade {
+ {mc "&Preferences" command doprefs}
+ }}
+ set view {
+ mc "&View" cascade {
+ {mc "&New view..." command {newview 0} -accelerator Shift-F4}
+ {mc "&Edit view..." command editview -state disabled -accelerator F4}
+ {mc "&Delete view" command delview -state disabled}
+ {xx "" separator}
+ {mc "&All files" radiobutton {selectedview 0} -command {showview 0}}
+ }}
+ if {[tk windowingsystem] ne "aqua"} {
+ set help {
+ mc "&Help" cascade {
+ {mc "&About gitk" command about}
+ {mc "&Key bindings" command keys}
+ }}
+ set bar [list $file $edit $view $help]
+ } else {
+ proc ::tk::mac::ShowPreferences {} {doprefs}
+ proc ::tk::mac::Quit {} {doquit}
+ lset file end [lreplace [lindex $file end] end-1 end]
+ set apple {
+ xx "&Apple" cascade {
+ {mc "&About gitk" command about}
+ {xx "" separator}
+ }}
+ set help {
+ mc "&Help" cascade {
+ {mc "&Key bindings" command keys}
+ }}
+ set bar [list $apple $file $view $help]
}
- } else {
- eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
- eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
- }
+ makemenu .bar $bar
+ . configure -menu .bar
- # a scroll bar to rule them
- ${NS}::scrollbar $cscroll -command {allcanvs yview}
- if {!$use_ttk} {$cscroll configure -highlightthickness 0}
- pack $cscroll -side right -fill y
- bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
- lappend bglist $canv $canv2 $canv3
- pack .tf.histframe.pwclist -fill both -expand 1 -side left
-
- # we have two button bars at bottom of top frame. Bar 1
- ${NS}::frame .tf.bar
- ${NS}::frame .tf.lbar -height 15
-
- set sha1entry .tf.bar.sha1
- set entries $sha1entry
- set sha1but .tf.bar.sha1label
- button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
- -command gotocommit -width 8
- $sha1but conf -disabledforeground [$sha1but cget -foreground]
- pack .tf.bar.sha1label -side left
- ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
- trace add variable sha1string write sha1change
- pack $sha1entry -side left -pady 2
-
- set bm_left_data {
- #define left_width 16
- #define left_height 16
- static unsigned char left_bits[] = {
- 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
- 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
- 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
- }
- set bm_right_data {
- #define right_width 16
- #define right_height 16
- static unsigned char right_bits[] = {
- 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
- 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
- 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
- }
- image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
- image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
- image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
- image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
-
- ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
- if {$use_ttk} {
- .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
- } else {
- .tf.bar.leftbut configure -image bm-left
- }
- pack .tf.bar.leftbut -side left -fill y
- ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
- if {$use_ttk} {
- .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
- } else {
- .tf.bar.rightbut configure -image bm-right
- }
- pack .tf.bar.rightbut -side left -fill y
-
- ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
- set rownumsel {}
- ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
- -relief sunken -anchor e
- ${NS}::label .tf.bar.rowlabel2 -text "/"
- ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
- -relief sunken -anchor e
- pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
- -side left
- if {!$use_ttk} {
- foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
- }
- global selectedline
- trace add variable selectedline write selectedline_change
-
- # Status label and progress bar
- set statusw .tf.bar.status
- ${NS}::label $statusw -width 15 -relief sunken
- pack $statusw -side left -padx 5
- if {$use_ttk} {
- set progresscanv [ttk::progressbar .tf.bar.progress]
- } else {
- 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 "#00ff00"]
- 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 -padx {0 2}
- 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
- ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
-
- set bm_down_data {
- #define down_width 16
- #define down_height 16
- static unsigned char down_bits[] = {
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
- 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
- }
- image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
- ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
- .tf.lbar.fnext configure -image bm-down
-
- set bm_up_data {
- #define up_width 16
- #define up_height 16
- static unsigned char up_bits[] = {
- 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
- 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
- 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
- }
- image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
- ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
- .tf.lbar.fprev configure -image bm-up
-
- ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
-
- pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
- -side left -fill y
- set gdttype [mc "containing:"]
- set gm [makedroplist .tf.lbar.gdttype gdttype \
- [mc "containing:"] \
- [mc "touching paths:"] \
- [mc "adding/removing string:"] \
- [mc "changing lines matching:"]]
- trace add variable gdttype write gdttype_change
- pack .tf.lbar.gdttype -side left -fill y
-
- set findstring {}
- set fstring .tf.lbar.findstring
- lappend entries $fstring
- ${NS}::entry $fstring -width 30 -textvariable findstring
- trace add variable findstring write find_change
- set findtype [mc "Exact"]
- set findtypemenu [makedroplist .tf.lbar.findtype \
- findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
- trace add variable findtype write findcom_change
- set findloc [mc "All fields"]
- makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
- [mc "Comments"] [mc "Author"] [mc "Committer"]
- trace add variable findloc write find_change
- 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
- pack .tf.bar -in .tf -side bottom -fill x
- pack .tf.histframe -fill both -side top -expand 1
- .ctop add .tf
- if {!$use_ttk} {
- .ctop paneconfigure .tf -height $geometry(topheight)
- .ctop paneconfigure .tf -width $geometry(topwidth)
- }
-
- # now build up the bottom
- ${NS}::panedwindow .pwbottom -orient horizontal
-
- # lower left, a text box over search bar, scroll bar to the right
- # if we know window height, then that will set the lower text height, otherwise
- # we set lower text height which will drive window height
- if {[info exists geometry(main)]} {
- ${NS}::frame .bleft -width $geometry(botwidth)
- } else {
- ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
- }
- ${NS}::frame .bleft.top
- ${NS}::frame .bleft.mid
- ${NS}::frame .bleft.bottom
-
- # gap between sub-widgets
- set wgap [font measure uifont "i"]
-
- ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
- pack .bleft.top.search -side left -padx 5
- set sstring .bleft.top.sstring
- set searchstring ""
- ${NS}::entry $sstring -width 20 -textvariable searchstring
- lappend entries $sstring
- trace add variable searchstring write incrsearch
- pack $sstring -side left -expand 1 -fill x
- ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
- -command changediffdisp -variable diffelide -value {0 0}
- ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
- -command changediffdisp -variable diffelide -value {0 1}
- ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
- -command changediffdisp -variable diffelide -value {1 0}
-
- ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
- pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
- spinbox .bleft.mid.diffcontext -width 5 \
- -from 0 -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 -ipadx $wgap
- ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
- -command changeignorespace -variable ignorespace
- pack .bleft.mid.ignspace -side left -padx 5
-
- set worddiff [mc "Line diff"]
- if {[package vcompare $git_version "1.7.2"] >= 0} {
- makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
- [mc "Markup words"] [mc "Color words"]
- trace add variable worddiff write changeworddiff
- pack .bleft.mid.worddiff -side left -padx 5
- }
-
- set ctext .bleft.bottom.ctext
- text $ctext -background $bgcolor -foreground $fgcolor \
- -state disabled -undo 0 -font textfont \
- -yscrollcommand scrolltext -wrap none \
- -xscrollcommand ".bleft.bottom.sbhorizontal set"
- if {$have_tk85} {
- $ctext conf -tabstyle wordprocessor
- }
- ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
- ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
- pack .bleft.top -side top -fill x
- pack .bleft.mid -side top -fill x
- grid $ctext .bleft.bottom.sb -sticky nsew
- grid .bleft.bottom.sbhorizontal -sticky ew
- grid columnconfigure .bleft.bottom 0 -weight 1
- grid rowconfigure .bleft.bottom 0 -weight 1
- grid rowconfigure .bleft.bottom 1 -weight 0
- pack .bleft.bottom -side top -fill both -expand 1
- lappend bglist $ctext
- lappend fglist $ctext
-
- $ctext tag conf comment -wrap $wrapcomment
- $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
- $ctext tag conf hunksep -fore [lindex $diffcolors 2]
- $ctext tag conf d0 -fore [lindex $diffcolors 0]
- $ctext tag conf dresult -fore [lindex $diffcolors 1]
- $ctext tag conf m0 -fore [lindex $mergecolors 0]
- $ctext tag conf m1 -fore [lindex $mergecolors 1]
- $ctext tag conf m2 -fore [lindex $mergecolors 2]
- $ctext tag conf m3 -fore [lindex $mergecolors 3]
- $ctext tag conf m4 -fore [lindex $mergecolors 4]
- $ctext tag conf m5 -fore [lindex $mergecolors 5]
- $ctext tag conf m6 -fore [lindex $mergecolors 6]
- $ctext tag conf m7 -fore [lindex $mergecolors 7]
- $ctext tag conf m8 -fore [lindex $mergecolors 8]
- $ctext tag conf m9 -fore [lindex $mergecolors 9]
- $ctext tag conf m10 -fore [lindex $mergecolors 10]
- $ctext tag conf m11 -fore [lindex $mergecolors 11]
- $ctext tag conf m12 -fore [lindex $mergecolors 12]
- $ctext tag conf m13 -fore [lindex $mergecolors 13]
- $ctext tag conf m14 -fore [lindex $mergecolors 14]
- $ctext tag conf m15 -fore [lindex $mergecolors 15]
- $ctext tag conf mmax -fore darkgrey
- set mergemax 16
- $ctext tag conf mresult -font textfontbold
- $ctext tag conf msep -font textfontbold
- $ctext tag conf found -back $foundbgcolor
- $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
- $ctext tag conf wwrap -wrap word -lmargin2 1c
- $ctext tag conf bold -font textfontbold
-
- .pwbottom add .bleft
- if {!$use_ttk} {
- .pwbottom paneconfigure .bleft -width $geometry(botwidth)
- }
-
- # lower right
- ${NS}::frame .bright
- ${NS}::frame .bright.mode
- ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
- -command reselectline -variable cmitmode -value "patch"
- ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
- -command reselectline -variable cmitmode -value "tree"
- 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"]
- text $cflist \
- -selectbackground $selectbgcolor \
- -background $bgcolor -foreground $fgcolor \
- -font mainfont \
- -tabs [list $indent [expr {2 * $indent}]] \
- -yscrollcommand ".bright.sb set" \
- -cursor [. cget -cursor] \
- -spacing1 1 -spacing3 1
- lappend bglist $cflist
- lappend fglist $cflist
- ${NS}::scrollbar .bright.sb -command "$cflist yview"
- pack .bright.sb -side right -fill y
- pack $cflist -side left -fill both -expand 1
- $cflist tag configure highlight \
- -background [$cflist cget -selectbackground]
- $cflist tag configure bold -font mainfontbold
-
- .pwbottom add .bright
- .ctop add .pwbottom
-
- # restore window width & height if known
- if {[info exists geometry(main)]} {
- if {[scan $geometry(main) "%dx%d" w h] >= 2} {
- if {$w > [winfo screenwidth .]} {
- set w [winfo screenwidth .]
- }
- if {$h > [winfo screenheight .]} {
- set h [winfo screenheight .]
- }
- wm geometry . "${w}x$h"
+ if {$use_ttk} {
+ # cover the non-themed toplevel with a themed frame.
+ place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1
}
- }
- if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
- wm state . $geometry(state)
- }
+ # the gui has upper and lower half, parts of a paned window.
+ ${NS}::panedwindow .ctop -orient vertical
- if {[tk windowingsystem] eq {aqua}} {
- set M1B M1
- set ::BM "3"
- } else {
- set M1B Control
- set ::BM "2"
- }
-
- if {$use_ttk} {
- bind .ctop <Map> {
- bind %W <Map> {}
- %W sashpos 0 $::geometry(topheight)
- }
- bind .pwbottom <Map> {
- bind %W <Map> {}
- %W sashpos 0 $::geometry(botwidth)
- }
- bind .pwbottom <Configure> {resizecdetpanes %W %w}
- }
-
- pack .ctop -fill both -expand 1
- bindall <1> {selcanvline %W %x %y}
- #bindall <B1-Motion> {selcanvline %W %x %y}
- 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"
- bind $ctext <Button> {
- if {"%b" eq 6} {
- $ctext xview scroll -5 units
- } elseif {"%b" eq 7} {
- $ctext xview scroll 5 units
- }
+ # possibly use assumed geometry
+ if {![info exists geometry(pwsash0)]} {
+ set geometry(topheight) [expr {15 * $linespc}]
+ set geometry(topwidth) [expr {80 * $charspc}]
+ set geometry(botheight) [expr {15 * $linespc}]
+ set geometry(botwidth) [expr {50 * $charspc}]
+ set geometry(pwsash0) [list [expr {40 * $charspc}] 2]
+ set geometry(pwsash1) [list [expr {60 * $charspc}] 2]
}
- if {[tk windowingsystem] eq "aqua"} {
- bindall <MouseWheel> {
- set delta [expr {- (%D)}]
- allcanvs yview scroll $delta units
- }
- bindall <Shift-MouseWheel> {
- set delta [expr {- (%D)}]
- $canv xview scroll $delta units
- }
- }
- }
- bindall <$::BM> "canvscan mark %W %x %y"
- bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
- bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
- bind . <$M1B-Key-w> doquit
- bindkey <Home> selfirstline
- bindkey <End> sellastline
- bind . <Key-Up> "selnextline -1"
- bind . <Key-Down> "selnextline 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"
- bind . <Key-Next> "selnextpage 1"
- bind . <$M1B-Home> "allcanvs yview moveto 0.0"
- bind . <$M1B-End> "allcanvs yview moveto 1.0"
- bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
- bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
- bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
- bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
- bindkey <Key-Delete> "$ctext yview scroll -1 pages"
- bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
- bindkey <Key-space> "$ctext yview scroll 1 pages"
- bindkey p "selnextline -1"
- bindkey n "selnextline 1"
- bindkey z "goback"
- bindkey x "goforw"
- bindkey k "selnextline -1"
- bindkey j "selnextline 1"
- bindkey h "goback"
- bindkey l "goforw"
- bindkey b prevfile
- bindkey d "$ctext yview scroll 18 units"
- bindkey u "$ctext yview scroll -18 units"
- bindkey g {$sha1entry delete 0 end; focus $sha1entry}
- bindkey / {focus $fstring}
- bindkey <Key-KP_Divide> {focus $fstring}
- bindkey <Key-Return> {dofind 1 1}
- bindkey ? {dofind -1 1}
- bindkey f nextfile
- bind . <F5> updatecommits
- bindmodfunctionkey Shift 5 reloadcommits
- bind . <F2> showrefs
- bindmodfunctionkey Shift 4 {newview 0}
- bind . <F4> edit_or_newview
- bind . <$M1B-q> doquit
- 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-plus> {incrfont 1}
- bind . <$M1B-KP_Add> {incrfont 1}
- bind . <$M1B-minus> {incrfont -1}
- bind . <$M1B-KP_Subtract> {incrfont -1}
- wm protocol . WM_DELETE_WINDOW doquit
- bind . <Destroy> {stop_backends}
- bind . <Button-1> "click %W"
- bind $fstring <Key-Return> {dofind 1 1}
- bind $sha1entry <Key-Return> {gotocommit; break}
- bind $sha1entry <<PasteSelection>> clearsha1
- bind $sha1entry <<Paste>> clearsha1
- bind $cflist <1> {sel_flist %W %x %y; break}
- bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
- bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
- global ctxbut
- bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
- bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
- bind $ctext <Button-1> {focus %W}
- bind $ctext <<Selection>> rehighlight_search_results
- for {set i 1} {$i < 10} {incr i} {
- bind . <$M1B-Key-$i> [list go_to_parent $i]
- }
- set maincursor [. cget -cursor]
- set textcursor [$ctext cget -cursor]
- set curtextcursor $textcursor
+ # the upper half will have a paned window, a scroll bar to the right, and some stuff below
+ ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth)
+ ${NS}::frame .tf.histframe
+ ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal
+ if {!$use_ttk} {
+ .tf.histframe.pwclist configure -sashpad 0 -handlesize 4
+ }
- set rowctxmenu .rowctxmenu
- makemenu $rowctxmenu {
- {mc "Diff this -> selected" command {diffvssel 0}}
- {mc "Diff selected -> this" command {diffvssel 1}}
- {mc "Make patch" command mkpatch}
- {mc "Create tag" command mktag}
- {mc "Copy commit reference" command copyreference}
- {mc "Write commit to file" command writecommit}
- {mc "Create new branch" command mkbranch}
- {mc "Cherry-pick this commit" command cherrypick}
- {mc "Reset HEAD branch to here" command resethead}
- {mc "Mark this commit" command markhere}
- {mc "Return to mark" command gotomark}
- {mc "Find descendant of this and mark" command find_common_desc}
- {mc "Compare with marked commit" command compare_commits}
- {mc "Diff this -> marked commit" command {diffvsmark 0}}
- {mc "Diff marked commit -> this" command {diffvsmark 1}}
- {mc "Revert this commit" command revert}
- }
- $rowctxmenu configure -tearoff 0
+ # create three canvases
+ set cscroll .tf.histframe.csb
+ set canv .tf.histframe.pwclist.canv
+ canvas $canv \
+ -selectbackground $selectbgcolor \
+ -background $bgcolor -bd 0 \
+ -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
+ .tf.histframe.pwclist add $canv
+ set canv2 .tf.histframe.pwclist.canv2
+ canvas $canv2 \
+ -selectbackground $selectbgcolor \
+ -background $bgcolor -bd 0 -yscrollincr $linespc
+ .tf.histframe.pwclist add $canv2
+ set canv3 .tf.histframe.pwclist.canv3
+ canvas $canv3 \
+ -selectbackground $selectbgcolor \
+ -background $bgcolor -bd 0 -yscrollincr $linespc
+ .tf.histframe.pwclist add $canv3
+ if {$use_ttk} {
+ bind .tf.histframe.pwclist <Map> {
+ bind %W <Map> {}
+ .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0]
+ .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0]
+ }
+ } else {
+ eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0)
+ eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1)
+ }
- set fakerowmenu .fakerowmenu
- makemenu $fakerowmenu {
- {mc "Diff this -> selected" command {diffvssel 0}}
- {mc "Diff selected -> this" command {diffvssel 1}}
- {mc "Make patch" command mkpatch}
- {mc "Diff this -> marked commit" command {diffvsmark 0}}
- {mc "Diff marked commit -> this" command {diffvsmark 1}}
- }
- $fakerowmenu configure -tearoff 0
+ # a scroll bar to rule them
+ ${NS}::scrollbar $cscroll -command {allcanvs yview}
+ if {!$use_ttk} {$cscroll configure -highlightthickness 0}
+ pack $cscroll -side right -fill y
+ bind .tf.histframe.pwclist <Configure> {resizeclistpanes %W %w}
+ lappend bglist $canv $canv2 $canv3
+ pack .tf.histframe.pwclist -fill both -expand 1 -side left
- set headctxmenu .headctxmenu
- makemenu $headctxmenu {
- {mc "Check out this branch" command cobranch}
- {mc "Rename this branch" command mvbranch}
- {mc "Remove this branch" command rmbranch}
- {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
- }
- $headctxmenu configure -tearoff 0
+ # we have two button bars at bottom of top frame. Bar 1
+ ${NS}::frame .tf.bar
+ ${NS}::frame .tf.lbar -height 15
- global flist_menu
- set flist_menu .flistctxmenu
- makemenu $flist_menu {
- {mc "Highlight this too" command {flist_hl 0}}
- {mc "Highlight this only" command {flist_hl 1}}
- {mc "External diff" command {external_diff}}
- {mc "Blame parent commit" command {external_blame 1}}
- {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
- }
- $flist_menu configure -tearoff 0
+ set sha1entry .tf.bar.sha1
+ set entries $sha1entry
+ set sha1but .tf.bar.sha1label
+ button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \
+ -command gotocommit -width 8
+ $sha1but conf -disabledforeground [$sha1but cget -foreground]
+ pack .tf.bar.sha1label -side left
+ ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string
+ trace add variable sha1string write sha1change
+ pack $sha1entry -side left -pady 2
- global diff_menu
- set diff_menu .diffctxmenu
- makemenu $diff_menu {
- {mc "Show origin of this line" command show_line_source}
- {mc "Run git gui blame on this line" command {external_blame_diff}}
- }
- $diff_menu configure -tearoff 0
+ set bm_left_data {
+ #define left_width 16
+ #define left_height 16
+ static unsigned char left_bits[] = {
+ 0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
+ 0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
+ 0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
+ }
+ set bm_right_data {
+ #define right_width 16
+ #define right_height 16
+ static unsigned char right_bits[] = {
+ 0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
+ 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
+ 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
+ }
+ image create bitmap bm-left -data $bm_left_data -foreground $uifgcolor
+ image create bitmap bm-left-gray -data $bm_left_data -foreground $uifgdisabledcolor
+ image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor
+ image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor
+
+ ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26
+ if {$use_ttk} {
+ .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray]
+ } else {
+ .tf.bar.leftbut configure -image bm-left
+ }
+ pack .tf.bar.leftbut -side left -fill y
+ ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26
+ if {$use_ttk} {
+ .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray]
+ } else {
+ .tf.bar.rightbut configure -image bm-right
+ }
+ pack .tf.bar.rightbut -side left -fill y
+
+ ${NS}::label .tf.bar.rowlabel -text [mc "Row"]
+ set rownumsel {}
+ ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \
+ -relief sunken -anchor e
+ ${NS}::label .tf.bar.rowlabel2 -text "/"
+ ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \
+ -relief sunken -anchor e
+ pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \
+ -side left
+ if {!$use_ttk} {
+ foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont}
+ }
+ global selectedline
+ trace add variable selectedline write selectedline_change
+
+ # Status label and progress bar
+ set statusw .tf.bar.status
+ ${NS}::label $statusw -width 15 -relief sunken
+ pack $statusw -side left -padx 5
+ if {$use_ttk} {
+ set progresscanv [ttk::progressbar .tf.bar.progress]
+ } else {
+ 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 "#00ff00"]
+ 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 -padx {0 2}
+ 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
+ ${NS}::label .tf.lbar.flabel -text "[mc "Find"] "
+
+ set bm_down_data {
+ #define down_width 16
+ #define down_height 16
+ static unsigned char down_bits[] = {
+ 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
+ 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
+ 0x87, 0xe1, 0x8e, 0x71, 0x9c, 0x39, 0xb8, 0x1d,
+ 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01};
+ }
+ image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor
+ ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1}
+ .tf.lbar.fnext configure -image bm-down
+
+ set bm_up_data {
+ #define up_width 16
+ #define up_height 16
+ static unsigned char up_bits[] = {
+ 0x80, 0x01, 0xc0, 0x03, 0xe0, 0x07, 0xf0, 0x0f,
+ 0xb8, 0x1d, 0x9c, 0x39, 0x8e, 0x71, 0x87, 0xe1,
+ 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
+ 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
+ }
+ image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor
+ ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1}
+ .tf.lbar.fprev configure -image bm-up
+
+ ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] "
+
+ pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \
+ -side left -fill y
+ set gdttype [mc "containing:"]
+ set gm [makedroplist .tf.lbar.gdttype gdttype \
+ [mc "containing:"] \
+ [mc "touching paths:"] \
+ [mc "adding/removing string:"] \
+ [mc "changing lines matching:"]]
+ trace add variable gdttype write gdttype_change
+ pack .tf.lbar.gdttype -side left -fill y
+
+ set findstring {}
+ set fstring .tf.lbar.findstring
+ lappend entries $fstring
+ ${NS}::entry $fstring -width 30 -textvariable findstring
+ trace add variable findstring write find_change
+ set findtype [mc "Exact"]
+ set findtypemenu [makedroplist .tf.lbar.findtype \
+ findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]]
+ trace add variable findtype write findcom_change
+ set findloc [mc "All fields"]
+ makedroplist .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \
+ [mc "Comments"] [mc "Author"] [mc "Committer"]
+ trace add variable findloc write find_change
+ 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
+ pack .tf.bar -in .tf -side bottom -fill x
+ pack .tf.histframe -fill both -side top -expand 1
+ .ctop add .tf
+ if {!$use_ttk} {
+ .ctop paneconfigure .tf -height $geometry(topheight)
+ .ctop paneconfigure .tf -width $geometry(topwidth)
+ }
+
+ # now build up the bottom
+ ${NS}::panedwindow .pwbottom -orient horizontal
+
+ # lower left, a text box over search bar, scroll bar to the right
+ # if we know window height, then that will set the lower text height, otherwise
+ # we set lower text height which will drive window height
+ if {[info exists geometry(main)]} {
+ ${NS}::frame .bleft -width $geometry(botwidth)
+ } else {
+ ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight)
+ }
+ ${NS}::frame .bleft.top
+ ${NS}::frame .bleft.mid
+ ${NS}::frame .bleft.bottom
+
+ # gap between sub-widgets
+ set wgap [font measure uifont "i"]
+
+ ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch
+ pack .bleft.top.search -side left -padx 5
+ set sstring .bleft.top.sstring
+ set searchstring ""
+ ${NS}::entry $sstring -width 20 -textvariable searchstring
+ lappend entries $sstring
+ trace add variable searchstring write incrsearch
+ pack $sstring -side left -expand 1 -fill x
+ ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \
+ -command changediffdisp -variable diffelide -value {0 0}
+ ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \
+ -command changediffdisp -variable diffelide -value {0 1}
+ ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \
+ -command changediffdisp -variable diffelide -value {1 0}
+
+ ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: "
+ pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap
+ spinbox .bleft.mid.diffcontext -width 5 \
+ -from 0 -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 -ipadx $wgap
+ ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \
+ -command changeignorespace -variable ignorespace
+ pack .bleft.mid.ignspace -side left -padx 5
+
+ set worddiff [mc "Line diff"]
+ if {[package vcompare $git_version "1.7.2"] >= 0} {
+ makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \
+ [mc "Markup words"] [mc "Color words"]
+ trace add variable worddiff write changeworddiff
+ pack .bleft.mid.worddiff -side left -padx 5
+ }
+
+ set ctext .bleft.bottom.ctext
+ text $ctext -background $bgcolor -foreground $fgcolor \
+ -state disabled -undo 0 -font textfont \
+ -yscrollcommand scrolltext -wrap none \
+ -xscrollcommand ".bleft.bottom.sbhorizontal set"
+ if {$have_tk85} {
+ $ctext conf -tabstyle wordprocessor
+ }
+ ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview"
+ ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h
+ pack .bleft.top -side top -fill x
+ pack .bleft.mid -side top -fill x
+ grid $ctext .bleft.bottom.sb -sticky nsew
+ grid .bleft.bottom.sbhorizontal -sticky ew
+ grid columnconfigure .bleft.bottom 0 -weight 1
+ grid rowconfigure .bleft.bottom 0 -weight 1
+ grid rowconfigure .bleft.bottom 1 -weight 0
+ pack .bleft.bottom -side top -fill both -expand 1
+ lappend bglist $ctext
+ lappend fglist $ctext
+
+ $ctext tag conf comment -wrap $wrapcomment
+ $ctext tag conf filesep -font textfontbold -fore $filesepfgcolor -back $filesepbgcolor
+ $ctext tag conf hunksep -fore [lindex $diffcolors 2]
+ $ctext tag conf d0 -fore [lindex $diffcolors 0]
+ $ctext tag conf dresult -fore [lindex $diffcolors 1]
+ $ctext tag conf m0 -fore [lindex $mergecolors 0]
+ $ctext tag conf m1 -fore [lindex $mergecolors 1]
+ $ctext tag conf m2 -fore [lindex $mergecolors 2]
+ $ctext tag conf m3 -fore [lindex $mergecolors 3]
+ $ctext tag conf m4 -fore [lindex $mergecolors 4]
+ $ctext tag conf m5 -fore [lindex $mergecolors 5]
+ $ctext tag conf m6 -fore [lindex $mergecolors 6]
+ $ctext tag conf m7 -fore [lindex $mergecolors 7]
+ $ctext tag conf m8 -fore [lindex $mergecolors 8]
+ $ctext tag conf m9 -fore [lindex $mergecolors 9]
+ $ctext tag conf m10 -fore [lindex $mergecolors 10]
+ $ctext tag conf m11 -fore [lindex $mergecolors 11]
+ $ctext tag conf m12 -fore [lindex $mergecolors 12]
+ $ctext tag conf m13 -fore [lindex $mergecolors 13]
+ $ctext tag conf m14 -fore [lindex $mergecolors 14]
+ $ctext tag conf m15 -fore [lindex $mergecolors 15]
+ $ctext tag conf mmax -fore darkgrey
+ set mergemax 16
+ $ctext tag conf mresult -font textfontbold
+ $ctext tag conf msep -font textfontbold
+ $ctext tag conf found -back $foundbgcolor
+ $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor
+ $ctext tag conf wwrap -wrap word -lmargin2 1c
+ $ctext tag conf bold -font textfontbold
+
+ .pwbottom add .bleft
+ if {!$use_ttk} {
+ .pwbottom paneconfigure .bleft -width $geometry(botwidth)
+ }
+
+ # lower right
+ ${NS}::frame .bright
+ ${NS}::frame .bright.mode
+ ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \
+ -command reselectline -variable cmitmode -value "patch"
+ ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \
+ -command reselectline -variable cmitmode -value "tree"
+ 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"]
+ text $cflist \
+ -selectbackground $selectbgcolor \
+ -background $bgcolor -foreground $fgcolor \
+ -font mainfont \
+ -tabs [list $indent [expr {2 * $indent}]] \
+ -yscrollcommand ".bright.sb set" \
+ -cursor [. cget -cursor] \
+ -spacing1 1 -spacing3 1
+ lappend bglist $cflist
+ lappend fglist $cflist
+ ${NS}::scrollbar .bright.sb -command "$cflist yview"
+ pack .bright.sb -side right -fill y
+ pack $cflist -side left -fill both -expand 1
+ $cflist tag configure highlight \
+ -background [$cflist cget -selectbackground]
+ $cflist tag configure bold -font mainfontbold
+
+ .pwbottom add .bright
+ .ctop add .pwbottom
+
+ # restore window width & height if known
+ if {[info exists geometry(main)]} {
+ if {[scan $geometry(main) "%dx%d" w h] >= 2} {
+ if {$w > [winfo screenwidth .]} {
+ set w [winfo screenwidth .]
+ }
+ if {$h > [winfo screenheight .]} {
+ set h [winfo screenheight .]
+ }
+ wm geometry . "${w}x$h"
+ }
+ }
+
+ if {[info exists geometry(state)] && $geometry(state) eq "zoomed"} {
+ wm state . $geometry(state)
+ }
+
+ if {[tk windowingsystem] eq {aqua}} {
+ set M1B M1
+ set ::BM "3"
+ } else {
+ set M1B Control
+ set ::BM "2"
+ }
+
+ if {$use_ttk} {
+ bind .ctop <Map> {
+ bind %W <Map> {}
+ %W sashpos 0 $::geometry(topheight)
+ }
+ bind .pwbottom <Map> {
+ bind %W <Map> {}
+ %W sashpos 0 $::geometry(botwidth)
+ }
+ bind .pwbottom <Configure> {resizecdetpanes %W %w}
+ }
+
+ pack .ctop -fill both -expand 1
+ bindall <1> {selcanvline %W %x %y}
+ #bindall <B1-Motion> {selcanvline %W %x %y}
+ 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"
+ bind $ctext <Button> {
+ if {"%b" eq 6} {
+ $ctext xview scroll -5 units
+ } elseif {"%b" eq 7} {
+ $ctext xview scroll 5 units
+ }
+ }
+ if {[tk windowingsystem] eq "aqua"} {
+ bindall <MouseWheel> {
+ set delta [expr {- (%D)}]
+ allcanvs yview scroll $delta units
+ }
+ bindall <Shift-MouseWheel> {
+ set delta [expr {- (%D)}]
+ $canv xview scroll $delta units
+ }
+ }
+ }
+ bindall <$::BM> "canvscan mark %W %x %y"
+ bindall <B$::BM-Motion> "canvscan dragto %W %x %y"
+ bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
+ bind . <$M1B-Key-w> doquit
+ bindkey <Home> selfirstline
+ bindkey <End> sellastline
+ bind . <Key-Up> "selnextline -1"
+ bind . <Key-Down> "selnextline 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"
+ bind . <Key-Next> "selnextpage 1"
+ bind . <$M1B-Home> "allcanvs yview moveto 0.0"
+ bind . <$M1B-End> "allcanvs yview moveto 1.0"
+ bind . <$M1B-Key-Up> "allcanvs yview scroll -1 units"
+ bind . <$M1B-Key-Down> "allcanvs yview scroll 1 units"
+ bind . <$M1B-Key-Prior> "allcanvs yview scroll -1 pages"
+ bind . <$M1B-Key-Next> "allcanvs yview scroll 1 pages"
+ bindkey <Key-Delete> "$ctext yview scroll -1 pages"
+ bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
+ bindkey <Key-space> "$ctext yview scroll 1 pages"
+ bindkey p "selnextline -1"
+ bindkey n "selnextline 1"
+ bindkey z "goback"
+ bindkey x "goforw"
+ bindkey k "selnextline -1"
+ bindkey j "selnextline 1"
+ bindkey h "goback"
+ bindkey l "goforw"
+ bindkey b prevfile
+ bindkey d "$ctext yview scroll 18 units"
+ bindkey u "$ctext yview scroll -18 units"
+ bindkey g {$sha1entry delete 0 end; focus $sha1entry}
+ bindkey / {focus $fstring}
+ bindkey <Key-KP_Divide> {focus $fstring}
+ bindkey <Key-Return> {dofind 1 1}
+ bindkey ? {dofind -1 1}
+ bindkey f nextfile
+ bind . <F5> updatecommits
+ bindmodfunctionkey Shift 5 reloadcommits
+ bind . <F2> showrefs
+ bindmodfunctionkey Shift 4 {newview 0}
+ bind . <F4> edit_or_newview
+ bind . <$M1B-q> doquit
+ 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-plus> {incrfont 1}
+ bind . <$M1B-KP_Add> {incrfont 1}
+ bind . <$M1B-minus> {incrfont -1}
+ bind . <$M1B-KP_Subtract> {incrfont -1}
+ wm protocol . WM_DELETE_WINDOW doquit
+ bind . <Destroy> {stop_backends}
+ bind . <Button-1> "click %W"
+ bind $fstring <Key-Return> {dofind 1 1}
+ bind $sha1entry <Key-Return> {gotocommit; break}
+ bind $sha1entry <<PasteSelection>> clearsha1
+ bind $sha1entry <<Paste>> clearsha1
+ bind $cflist <1> {sel_flist %W %x %y; break}
+ bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
+ bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
+ global ctxbut
+ bind $cflist $ctxbut {pop_flist_menu %W %X %Y %x %y}
+ bind $ctext $ctxbut {pop_diff_menu %W %X %Y %x %y}
+ bind $ctext <Button-1> {focus %W}
+ bind $ctext <<Selection>> rehighlight_search_results
+ for {set i 1} {$i < 10} {incr i} {
+ bind . <$M1B-Key-$i> [list go_to_parent $i]
+ }
+
+ set maincursor [. cget -cursor]
+ set textcursor [$ctext cget -cursor]
+ set curtextcursor $textcursor
+
+ set rowctxmenu .rowctxmenu
+ makemenu $rowctxmenu {
+ {mc "Diff this -> selected" command {diffvssel 0}}
+ {mc "Diff selected -> this" command {diffvssel 1}}
+ {mc "Make patch" command mkpatch}
+ {mc "Create tag" command mktag}
+ {mc "Copy commit reference" command copyreference}
+ {mc "Write commit to file" command writecommit}
+ {mc "Create new branch" command mkbranch}
+ {mc "Cherry-pick this commit" command cherrypick}
+ {mc "Reset HEAD branch to here" command resethead}
+ {mc "Mark this commit" command markhere}
+ {mc "Return to mark" command gotomark}
+ {mc "Find descendant of this and mark" command find_common_desc}
+ {mc "Compare with marked commit" command compare_commits}
+ {mc "Diff this -> marked commit" command {diffvsmark 0}}
+ {mc "Diff marked commit -> this" command {diffvsmark 1}}
+ {mc "Revert this commit" command revert}
+ }
+ $rowctxmenu configure -tearoff 0
+
+ set fakerowmenu .fakerowmenu
+ makemenu $fakerowmenu {
+ {mc "Diff this -> selected" command {diffvssel 0}}
+ {mc "Diff selected -> this" command {diffvssel 1}}
+ {mc "Make patch" command mkpatch}
+ {mc "Diff this -> marked commit" command {diffvsmark 0}}
+ {mc "Diff marked commit -> this" command {diffvsmark 1}}
+ }
+ $fakerowmenu configure -tearoff 0
+
+ set headctxmenu .headctxmenu
+ makemenu $headctxmenu {
+ {mc "Check out this branch" command cobranch}
+ {mc "Rename this branch" command mvbranch}
+ {mc "Remove this branch" command rmbranch}
+ {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}}
+ }
+ $headctxmenu configure -tearoff 0
+
+ global flist_menu
+ set flist_menu .flistctxmenu
+ makemenu $flist_menu {
+ {mc "Highlight this too" command {flist_hl 0}}
+ {mc "Highlight this only" command {flist_hl 1}}
+ {mc "External diff" command {external_diff}}
+ {mc "Blame parent commit" command {external_blame 1}}
+ {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}}
+ }
+ $flist_menu configure -tearoff 0
+
+ global diff_menu
+ set diff_menu .diffctxmenu
+ makemenu $diff_menu {
+ {mc "Show origin of this line" command show_line_source}
+ {mc "Run git gui blame on this line" command {external_blame_diff}}
+ }
+ $diff_menu configure -tearoff 0
}
# 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
- }
+ 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
+ }
+ }
}
- }
}
# Update row number label when selectedline changes
proc selectedline_change {n1 n2 op} {
- global selectedline rownumsel
+ global selectedline rownumsel
- if {$selectedline eq {}} {
- set rownumsel {}
- } else {
- set rownumsel [expr {$selectedline + 1}]
- }
+ if {$selectedline eq {}} {
+ set rownumsel {}
+ } else {
+ set rownumsel [expr {$selectedline + 1}]
+ }
}
# mouse-2 makes all windows scan vertically, but only the one
# the cursor is in scans horizontally
proc canvscan {op w x y} {
- global canv canv2 canv3
- foreach c [list $canv $canv2 $canv3] {
- if {$c == $w} {
- $c scan $op $x $y
- } else {
- $c scan $op 0 $y
+ global canv canv2 canv3
+ foreach c [list $canv $canv2 $canv3] {
+ if {$c == $w} {
+ $c scan $op $x $y
+ } else {
+ $c scan $op 0 $y
+ }
}
- }
}
proc scrollcanv {cscroll f0 f1} {
- $cscroll set $f0 $f1
- drawvisible
- flushhighlights
+ $cscroll set $f0 $f1
+ drawvisible
+ flushhighlights
}
# when we make a key binding for the toplevel, make sure
# it doesn't get triggered when that key is pressed in the
# find string entry widget.
proc bindkey {ev script} {
- global entries
- bind . $ev $script
- set escript [bind Entry $ev]
- if {$escript == {}} {
- set escript [bind Entry <Key>]
- }
- foreach e $entries {
- bind $e $ev "$escript; break"
- }
+ global entries
+ bind . $ev $script
+ set escript [bind Entry $ev]
+ if {$escript == {}} {
+ set escript [bind Entry <Key>]
+ }
+ foreach e $entries {
+ bind $e $ev "$escript; break"
+ }
}
proc bindmodfunctionkey {mod n script} {
- bind . <$mod-F$n> $script
- catch { bind . <$mod-XF86_Switch_VT_$n> $script }
+ bind . <$mod-F$n> $script
+ catch { bind . <$mod-XF86_Switch_VT_$n> $script }
}
# set the focus back to the toplevel for any click outside
# the entry widgets
proc click {w} {
- global ctext entries
- foreach e [concat $entries $ctext] {
- if {$w == $e} return
- }
- focus .
+ 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 use_ttk
+ global progresscanv progressitem progresscoords
+ global fprogitem fprogcoord lastprogupdate progupdatepending
+ global rprogitem rprogcoord use_ttk
- if {$use_ttk} {
- $progresscanv configure -value [expr {int($fprogcoord * 100)}]
- return
- }
+ if {$use_ttk} {
+ $progresscanv configure -value [expr {int($fprogcoord * 100)}]
+ return
+ }
- 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
- }
+ 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
+ global lastprogupdate progupdatepending
- if {$progupdatepending} {
- set progupdatepending 0
- set lastprogupdate [clock clicks -milliseconds]
- update
- }
+ if {$progupdatepending} {
+ set progupdatepending 0
+ set lastprogupdate [clock clicks -milliseconds]
+ update
+ }
}
proc config_check_tmp_exists {tries_left} {
- global config_file_tmp
+ global config_file_tmp
- if {[file exists $config_file_tmp]} {
- incr tries_left -1
- if {$tries_left > 0} {
- after 100 [list config_check_tmp_exists $tries_left]
- } else {
- error_popup "There appears to be a stale $config_file_tmp\
+ if {[file exists $config_file_tmp]} {
+ incr tries_left -1
+ if {$tries_left > 0} {
+ after 100 [list config_check_tmp_exists $tries_left]
+ } else {
+ error_popup "There appears to be a stale $config_file_tmp\
file, which will prevent gitk from saving its configuration on exit.\
Please remove it if it is not being used by any existing gitk process."
+ }
}
- }
}
proc config_init_trace {name} {
- global config_variable_changed config_variable_original
+ global config_variable_changed config_variable_original
- upvar #0 $name var
- set config_variable_changed($name) 0
- set config_variable_original($name) $var
+ upvar #0 $name var
+ set config_variable_changed($name) 0
+ set config_variable_original($name) $var
}
proc config_variable_change_cb {name name2 op} {
- global config_variable_changed config_variable_original
+ global config_variable_changed config_variable_original
- upvar #0 $name var
- if {$op eq "write" &&
- (![info exists config_variable_original($name)] ||
- $config_variable_original($name) ne $var)} {
- set config_variable_changed($name) 1
- }
+ upvar #0 $name var
+ if {$op eq "write" &&
+ (![info exists config_variable_original($name)] ||
+ $config_variable_original($name) ne $var)} {
+ set config_variable_changed($name) 1
+ }
}
proc savestuff {w} {
- global stuffsaved
- global config_file config_file_tmp
- global config_variables config_variable_changed
- global viewchanged
+ global stuffsaved
+ global config_file config_file_tmp
+ global config_variables config_variable_changed
+ global viewchanged
- upvar #0 viewname current_viewname
- upvar #0 viewfiles current_viewfiles
- upvar #0 viewargs current_viewargs
- upvar #0 viewargscmd current_viewargscmd
- upvar #0 viewperm current_viewperm
- upvar #0 nextviewnum current_nextviewnum
- upvar #0 use_ttk current_use_ttk
+ upvar #0 viewname current_viewname
+ upvar #0 viewfiles current_viewfiles
+ upvar #0 viewargs current_viewargs
+ upvar #0 viewargscmd current_viewargscmd
+ upvar #0 viewperm current_viewperm
+ upvar #0 nextviewnum current_nextviewnum
+ upvar #0 use_ttk current_use_ttk
- if {$stuffsaved} return
- if {![winfo viewable .]} return
- set remove_tmp 0
- if {[catch {
- set try_count 0
- while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
- if {[incr try_count] > 50} {
- error "Unable to write config file: $config_file_tmp exists"
- }
- after 100
- }
- set remove_tmp 1
- if {$::tcl_platform(platform) eq {windows}} {
- file attributes $config_file_tmp -hidden true
- }
- if {[file exists $config_file]} {
- source $config_file
- }
- foreach var_name $config_variables {
- upvar #0 $var_name var
- upvar 0 $var_name old_var
- if {!$config_variable_changed($var_name) && [info exists old_var]} {
- puts $f [list set $var_name $old_var]
- } else {
- puts $f [list set $var_name $var]
- }
- }
-
- puts $f "set geometry(main) [wm geometry .]"
- puts $f "set geometry(state) [wm state .]"
- puts $f "set geometry(topwidth) [winfo width .tf]"
- puts $f "set geometry(topheight) [winfo height .tf]"
- if {$current_use_ttk} {
- puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
- puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
- } else {
- puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
- puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
- }
- puts $f "set geometry(botwidth) [winfo width .bleft]"
- puts $f "set geometry(botheight) [winfo height .bleft]"
-
- array set view_save {}
- array set views {}
- if {![info exists permviews]} { set permviews {} }
- foreach view $permviews {
- set view_save([lindex $view 0]) 1
- set views([lindex $view 0]) $view
- }
- puts -nonewline $f "set permviews {"
- for {set v 1} {$v < $current_nextviewnum} {incr v} {
- if {$viewchanged($v)} {
- if {$current_viewperm($v)} {
- set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
- } else {
- set view_save($current_viewname($v)) 0
- }
- }
- }
- # write old and updated view to their places and append remaining to the end
- foreach view $permviews {
- set view_name [lindex $view 0]
- if {$view_save($view_name)} {
- puts $f "{$views($view_name)}"
- }
- unset views($view_name)
- }
- foreach view_name [array names views] {
- puts $f "{$views($view_name)}"
- }
- puts $f "}"
- close $f
- file rename -force $config_file_tmp $config_file
+ if {$stuffsaved} return
+ if {![winfo viewable .]} return
set remove_tmp 0
- } err]} {
- puts "Error saving config: $err"
- }
- if {$remove_tmp} {
- file delete -force $config_file_tmp
- }
- set stuffsaved 1
+ if {[catch {
+ set try_count 0
+ while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} {
+ if {[incr try_count] > 50} {
+ error "Unable to write config file: $config_file_tmp exists"
+ }
+ after 100
+ }
+ set remove_tmp 1
+ if {$::tcl_platform(platform) eq {windows}} {
+ file attributes $config_file_tmp -hidden true
+ }
+ if {[file exists $config_file]} {
+ source $config_file
+ }
+ foreach var_name $config_variables {
+ upvar #0 $var_name var
+ upvar 0 $var_name old_var
+ if {!$config_variable_changed($var_name) && [info exists old_var]} {
+ puts $f [list set $var_name $old_var]
+ } else {
+ puts $f [list set $var_name $var]
+ }
+ }
+
+ puts $f "set geometry(main) [wm geometry .]"
+ puts $f "set geometry(state) [wm state .]"
+ puts $f "set geometry(topwidth) [winfo width .tf]"
+ puts $f "set geometry(topheight) [winfo height .tf]"
+ if {$current_use_ttk} {
+ puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\""
+ puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\""
+ } else {
+ puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\""
+ puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\""
+ }
+ puts $f "set geometry(botwidth) [winfo width .bleft]"
+ puts $f "set geometry(botheight) [winfo height .bleft]"
+
+ array set view_save {}
+ array set views {}
+ if {![info exists permviews]} { set permviews {} }
+ foreach view $permviews {
+ set view_save([lindex $view 0]) 1
+ set views([lindex $view 0]) $view
+ }
+ puts -nonewline $f "set permviews {"
+ for {set v 1} {$v < $current_nextviewnum} {incr v} {
+ if {$viewchanged($v)} {
+ if {$current_viewperm($v)} {
+ set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)]
+ } else {
+ set view_save($current_viewname($v)) 0
+ }
+ }
+ }
+ # write old and updated view to their places and append remaining to the end
+ foreach view $permviews {
+ set view_name [lindex $view 0]
+ if {$view_save($view_name)} {
+ puts $f "{$views($view_name)}"
+ }
+ unset views($view_name)
+ }
+ foreach view_name [array names views] {
+ puts $f "{$views($view_name)}"
+ }
+ puts $f "}"
+ close $f
+ file rename -force $config_file_tmp $config_file
+ set remove_tmp 0
+ } err]} {
+ puts "Error saving config: $err"
+ }
+ if {$remove_tmp} {
+ file delete -force $config_file_tmp
+ }
+ set stuffsaved 1
}
proc resizeclistpanes {win w} {
- global oldwidth use_ttk
- if {[info exists oldwidth($win)]} {
- if {$use_ttk} {
- set s0 [$win sashpos 0]
- set s1 [$win sashpos 1]
- } else {
- set s0 [$win sash coord 0]
- set s1 [$win sash coord 1]
- }
- if {$w < 60} {
- set sash0 [expr {int($w/2 - 2)}]
- set sash1 [expr {int($w*5/6 - 2)}]
- } else {
- set factor [expr {1.0 * $w / $oldwidth($win)}]
- set sash0 [expr {int($factor * [lindex $s0 0])}]
- set sash1 [expr {int($factor * [lindex $s1 0])}]
- if {$sash0 < 30} {
- set sash0 30
- }
- if {$sash1 < $sash0 + 20} {
- set sash1 [expr {$sash0 + 20}]
- }
- if {$sash1 > $w - 10} {
- set sash1 [expr {$w - 10}]
- if {$sash0 > $sash1 - 20} {
- set sash0 [expr {$sash1 - 20}]
+ global oldwidth use_ttk
+ if {[info exists oldwidth($win)]} {
+ if {$use_ttk} {
+ set s0 [$win sashpos 0]
+ set s1 [$win sashpos 1]
+ } else {
+ set s0 [$win sash coord 0]
+ set s1 [$win sash coord 1]
+ }
+ if {$w < 60} {
+ set sash0 [expr {int($w/2 - 2)}]
+ set sash1 [expr {int($w*5/6 - 2)}]
+ } else {
+ set factor [expr {1.0 * $w / $oldwidth($win)}]
+ set sash0 [expr {int($factor * [lindex $s0 0])}]
+ set sash1 [expr {int($factor * [lindex $s1 0])}]
+ if {$sash0 < 30} {
+ set sash0 30
+ }
+ if {$sash1 < $sash0 + 20} {
+ set sash1 [expr {$sash0 + 20}]
+ }
+ if {$sash1 > $w - 10} {
+ set sash1 [expr {$w - 10}]
+ if {$sash0 > $sash1 - 20} {
+ set sash0 [expr {$sash1 - 20}]
+ }
+ }
+ }
+ if {$use_ttk} {
+ $win sashpos 0 $sash0
+ $win sashpos 1 $sash1
+ } else {
+ $win sash place 0 $sash0 [lindex $s0 1]
+ $win sash place 1 $sash1 [lindex $s1 1]
}
- }
}
- if {$use_ttk} {
- $win sashpos 0 $sash0
- $win sashpos 1 $sash1
- } else {
- $win sash place 0 $sash0 [lindex $s0 1]
- $win sash place 1 $sash1 [lindex $s1 1]
- }
- }
- set oldwidth($win) $w
+ set oldwidth($win) $w
}
proc resizecdetpanes {win w} {
- global oldwidth use_ttk
- if {[info exists oldwidth($win)]} {
- if {$use_ttk} {
- set s0 [$win sashpos 0]
- } else {
- set s0 [$win sash coord 0]
+ global oldwidth use_ttk
+ if {[info exists oldwidth($win)]} {
+ if {$use_ttk} {
+ set s0 [$win sashpos 0]
+ } else {
+ set s0 [$win sash coord 0]
+ }
+ if {$w < 60} {
+ set sash0 [expr {int($w*3/4 - 2)}]
+ } else {
+ set factor [expr {1.0 * $w / $oldwidth($win)}]
+ set sash0 [expr {int($factor * [lindex $s0 0])}]
+ if {$sash0 < 45} {
+ set sash0 45
+ }
+ if {$sash0 > $w - 15} {
+ set sash0 [expr {$w - 15}]
+ }
+ }
+ if {$use_ttk} {
+ $win sashpos 0 $sash0
+ } else {
+ $win sash place 0 $sash0 [lindex $s0 1]
+ }
}
- if {$w < 60} {
- set sash0 [expr {int($w*3/4 - 2)}]
- } else {
- set factor [expr {1.0 * $w / $oldwidth($win)}]
- set sash0 [expr {int($factor * [lindex $s0 0])}]
- if {$sash0 < 45} {
- set sash0 45
- }
- if {$sash0 > $w - 15} {
- set sash0 [expr {$w - 15}]
- }
- }
- if {$use_ttk} {
- $win sashpos 0 $sash0
- } else {
- $win sash place 0 $sash0 [lindex $s0 1]
- }
- }
- set oldwidth($win) $w
+ set oldwidth($win) $w
}
proc allcanvs args {
- global canv canv2 canv3
- eval $canv $args
- eval $canv2 $args
- eval $canv3 $args
+ global canv canv2 canv3
+ eval $canv $args
+ eval $canv2 $args
+ eval $canv3 $args
}
proc bindall {event action} {
- global canv canv2 canv3
- bind $canv $event $action
- bind $canv2 $event $action
- bind $canv3 $event $action
+ global canv canv2 canv3
+ bind $canv $event $action
+ bind $canv2 $event $action
+ bind $canv3 $event $action
}
proc about {} {
- global bgcolor NS
- set w .about
- if {[winfo exists $w]} {
- raise $w
- return
- }
- ttk_toplevel $w
- wm title $w [mc "About gitk"]
- make_transient $w .
- message $w.m -text [mc "
+ global bgcolor NS
+ set w .about
+ if {[winfo exists $w]} {
+ raise $w
+ return
+ }
+ ttk_toplevel $w
+ wm title $w [mc "About gitk"]
+ make_transient $w .
+ message $w.m -text [mc "
Gitk - a commit viewer for git
Copyright \u00a9 2005-2016 Paul Mackerras
Use and redistribute under the terms of the GNU General Public License"] \
- -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
- pack $w.m -side top -fill x -padx 2 -pady 2
- ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
- pack $w.ok -side bottom
- bind $w <Visibility> "focus $w.ok"
- bind $w <Key-Escape> "destroy $w"
- bind $w <Key-Return> "destroy $w"
- tk::PlaceWindow $w widget .
+ -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove
+ pack $w.m -side top -fill x -padx 2 -pady 2
+ ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
+ pack $w.ok -side bottom
+ bind $w <Visibility> "focus $w.ok"
+ bind $w <Key-Escape> "destroy $w"
+ bind $w <Key-Return> "destroy $w"
+ tk::PlaceWindow $w widget .
}
proc keys {} {
- global bgcolor NS
- set w .keys
- if {[winfo exists $w]} {
- raise $w
- return
- }
- if {[tk windowingsystem] eq {aqua}} {
- set M1T Cmd
- } else {
- set M1T Ctrl
- }
- ttk_toplevel $w
- wm title $w [mc "Gitk key bindings"]
- make_transient $w .
- message $w.m -text "
+ global bgcolor NS
+ set w .keys
+ if {[winfo exists $w]} {
+ raise $w
+ return
+ }
+ if {[tk windowingsystem] eq {aqua}} {
+ set M1T Cmd
+ } else {
+ set M1T Ctrl
+ }
+ ttk_toplevel $w
+ wm title $w [mc "Gitk key bindings"]
+ make_transient $w .
+ message $w.m -text "
[mc "Gitk key bindings:"]
-[mc "<%s-Q> Quit" $M1T]
-[mc "<%s-W> Close window" $M1T]
-[mc "<Home> Move to first commit"]
-[mc "<End> Move to last commit"]
-[mc "<Up>, p, k Move up one commit"]
-[mc "<Down>, n, j Move down one commit"]
-[mc "<Left>, z, h Go back in history list"]
-[mc "<Right>, x, l Go forward in history list"]
-[mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
+[mc "<%s-Q> Quit" $M1T]
+[mc "<%s-W> Close window" $M1T]
+[mc "<Home> Move to first commit"]
+[mc "<End> Move to last commit"]
+[mc "<Up>, p, k Move up one commit"]
+[mc "<Down>, n, j Move down one commit"]
+[mc "<Left>, z, h Go back in history list"]
+[mc "<Right>, x, l Go forward in history list"]
+[mc "<%s-n> Go to n-th parent of current commit in history list" $M1T]
[mc "<PageUp> Move up one page in commit list"]
-[mc "<PageDown> Move down one page in commit list"]
+[mc "<PageDown> Move down one page in commit list"]
[mc "<%s-Home> Scroll to top of commit list" $M1T]
[mc "<%s-End> Scroll to bottom of commit list" $M1T]
[mc "<%s-Up> Scroll commit list up one line" $M1T]
[mc "<%s-Down> Scroll commit list down one line" $M1T]
-[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
-[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
-[mc "<Shift-Up> Find backwards (upwards, later commits)"]
-[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
-[mc "<Delete>, b Scroll diff view up one page"]
-[mc "<Backspace> Scroll diff view up one page"]
-[mc "<Space> Scroll diff view down one page"]
-[mc "u Scroll diff view up 18 lines"]
-[mc "d Scroll diff view down 18 lines"]
-[mc "<%s-F> Find" $M1T]
-[mc "<%s-G> Move to next find hit" $M1T]
+[mc "<%s-PageUp> Scroll commit list up one page" $M1T]
+[mc "<%s-PageDown> Scroll commit list down one page" $M1T]
+[mc "<Shift-Up> Find backwards (upwards, later commits)"]
+[mc "<Shift-Down> Find forwards (downwards, earlier commits)"]
+[mc "<Delete>, b Scroll diff view up one page"]
+[mc "<Backspace> Scroll diff view up one page"]
+[mc "<Space> Scroll diff view down one page"]
+[mc "u Scroll diff view up 18 lines"]
+[mc "d Scroll diff view down 18 lines"]
+[mc "<%s-F> Find" $M1T]
+[mc "<%s-G> Move to next find hit" $M1T]
[mc "<Return> Move to next find hit"]
-[mc "g Go to commit"]
-[mc "/ Focus the search box"]
-[mc "? Move to previous find hit"]
-[mc "f Scroll diff view to next file"]
-[mc "<%s-S> Search for next hit in diff view" $M1T]
-[mc "<%s-R> Search for previous hit in diff view" $M1T]
+[mc "g Go to commit"]
+[mc "/ Focus the search box"]
+[mc "? Move to previous find hit"]
+[mc "f Scroll diff view to next file"]
+[mc "<%s-S> Search for next hit in diff view" $M1T]
+[mc "<%s-R> Search for previous hit in diff view" $M1T]
[mc "<%s-KP+> Increase font size" $M1T]
[mc "<%s-plus> Increase font size" $M1T]
[mc "<%s-KP-> Decrease font size" $M1T]
-[mc "<%s-minus> Decrease font size" $M1T]
-[mc "<F5> Update"]
+[mc "<%s-minus> Decrease font size" $M1T]
+[mc "<F5> Update"]
" \
- -justify left -bg $bgcolor -border 2 -relief groove
- pack $w.m -side top -fill both -padx 2 -pady 2
- ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
- bind $w <Key-Escape> [list destroy $w]
- pack $w.ok -side bottom
- bind $w <Visibility> "focus $w.ok"
- bind $w <Key-Escape> "destroy $w"
- bind $w <Key-Return> "destroy $w"
+ -justify left -bg $bgcolor -border 2 -relief groove
+ pack $w.m -side top -fill both -padx 2 -pady 2
+ ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active
+ bind $w <Key-Escape> [list destroy $w]
+ pack $w.ok -side bottom
+ bind $w <Visibility> "focus $w.ok"
+ bind $w <Key-Escape> "destroy $w"
+ bind $w <Key-Return> "destroy $w"
}
# Procedures for manipulating the file list window at the
# bottom right of the overall window.
proc treeview {w l openlevs} {
- global treecontents treediropen treeheight treeparent treeindex
+ global treecontents treediropen treeheight treeparent treeindex
- set ix 0
- set treeindex() 0
- set lev 0
- set prefix {}
- set prefixend -1
- set prefendstack {}
- set htstack {}
- set ht 0
- set treecontents() {}
- $w conf -state normal
- foreach f $l {
- while {[string range $f 0 $prefixend] ne $prefix} {
- if {$lev <= $openlevs} {
- $w mark set e:$treeindex($prefix) "end -1c"
- $w mark gravity e:$treeindex($prefix) left
- }
- set treeheight($prefix) $ht
- incr ht [lindex $htstack end]
- set htstack [lreplace $htstack end end]
- set prefixend [lindex $prefendstack end]
- set prefendstack [lreplace $prefendstack end end]
- set prefix [string range $prefix 0 $prefixend]
- incr lev -1
+ set ix 0
+ set treeindex() 0
+ set lev 0
+ set prefix {}
+ set prefixend -1
+ set prefendstack {}
+ set htstack {}
+ set ht 0
+ set treecontents() {}
+ $w conf -state normal
+ foreach f $l {
+ while {[string range $f 0 $prefixend] ne $prefix} {
+ if {$lev <= $openlevs} {
+ $w mark set e:$treeindex($prefix) "end -1c"
+ $w mark gravity e:$treeindex($prefix) left
+ }
+ set treeheight($prefix) $ht
+ incr ht [lindex $htstack end]
+ set htstack [lreplace $htstack end end]
+ set prefixend [lindex $prefendstack end]
+ set prefendstack [lreplace $prefendstack end end]
+ set prefix [string range $prefix 0 $prefixend]
+ incr lev -1
+ }
+ set tail [string range $f [expr {$prefixend+1}] end]
+ while {[set slash [string first "/" $tail]] >= 0} {
+ lappend htstack $ht
+ set ht 0
+ lappend prefendstack $prefixend
+ incr prefixend [expr {$slash + 1}]
+ set d [string range $tail 0 $slash]
+ lappend treecontents($prefix) $d
+ set oldprefix $prefix
+ append prefix $d
+ set treecontents($prefix) {}
+ set treeindex($prefix) [incr ix]
+ set treeparent($prefix) $oldprefix
+ set tail [string range $tail [expr {$slash+1}] end]
+ if {$lev <= $openlevs} {
+ set ht 1
+ set treediropen($prefix) [expr {$lev < $openlevs}]
+ set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
+ $w mark set d:$ix "end -1c"
+ $w mark gravity d:$ix left
+ set str "\n"
+ for {set i 0} {$i < $lev} {incr i} {append str "\t"}
+ $w insert end $str
+ $w image create end -align center -image $bm -padx 1 \
+ -name a:$ix
+ $w insert end $d [highlight_tag $prefix]
+ $w mark set s:$ix "end -1c"
+ $w mark gravity s:$ix left
+ }
+ incr lev
+ }
+ if {$tail ne {}} {
+ if {$lev <= $openlevs} {
+ incr ht
+ set str "\n"
+ for {set i 0} {$i < $lev} {incr i} {append str "\t"}
+ $w insert end $str
+ $w insert end $tail [highlight_tag $f]
+ }
+ lappend treecontents($prefix) $tail
+ }
}
- set tail [string range $f [expr {$prefixend+1}] end]
- while {[set slash [string first "/" $tail]] >= 0} {
- lappend htstack $ht
- set ht 0
- lappend prefendstack $prefixend
- incr prefixend [expr {$slash + 1}]
- set d [string range $tail 0 $slash]
- lappend treecontents($prefix) $d
- set oldprefix $prefix
- append prefix $d
- set treecontents($prefix) {}
- set treeindex($prefix) [incr ix]
- set treeparent($prefix) $oldprefix
- set tail [string range $tail [expr {$slash+1}] end]
- if {$lev <= $openlevs} {
- set ht 1
- set treediropen($prefix) [expr {$lev < $openlevs}]
- set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
- $w mark set d:$ix "end -1c"
- $w mark gravity d:$ix left
- set str "\n"
- for {set i 0} {$i < $lev} {incr i} {append str "\t"}
- $w insert end $str
- $w image create end -align center -image $bm -padx 1 \
- -name a:$ix
- $w insert end $d [highlight_tag $prefix]
- $w mark set s:$ix "end -1c"
- $w mark gravity s:$ix left
- }
- incr lev
+ while {$htstack ne {}} {
+ set treeheight($prefix) $ht
+ incr ht [lindex $htstack end]
+ set htstack [lreplace $htstack end end]
+ set prefixend [lindex $prefendstack end]
+ set prefendstack [lreplace $prefendstack end end]
+ set prefix [string range $prefix 0 $prefixend]
}
- if {$tail ne {}} {
- if {$lev <= $openlevs} {
- incr ht
- set str "\n"
- for {set i 0} {$i < $lev} {incr i} {append str "\t"}
- $w insert end $str
- $w insert end $tail [highlight_tag $f]
- }
- lappend treecontents($prefix) $tail
- }
- }
- while {$htstack ne {}} {
- set treeheight($prefix) $ht
- incr ht [lindex $htstack end]
- set htstack [lreplace $htstack end end]
- set prefixend [lindex $prefendstack end]
- set prefendstack [lreplace $prefendstack end end]
- set prefix [string range $prefix 0 $prefixend]
- }
- $w conf -state disabled
+ $w conf -state disabled
}
proc linetoelt {l} {
- global treeheight treecontents
+ global treeheight treecontents
- set y 2
- set prefix {}
- while {1} {
- foreach e $treecontents($prefix) {
- if {$y == $l} {
- return "$prefix$e"
- }
- set n 1
- if {[string index $e end] eq "/"} {
- set n $treeheight($prefix$e)
- if {$y + $n > $l} {
- append prefix $e
- incr y
- break
+ set y 2
+ set prefix {}
+ while {1} {
+ foreach e $treecontents($prefix) {
+ if {$y == $l} {
+ return "$prefix$e"
+ }
+ set n 1
+ if {[string index $e end] eq "/"} {
+ set n $treeheight($prefix$e)
+ if {$y + $n > $l} {
+ append prefix $e
+ incr y
+ break
+ }
+ }
+ incr y $n
}
- }
- incr y $n
}
- }
}
proc highlight_tree {y prefix} {
- global treeheight treecontents cflist
+ global treeheight treecontents cflist
- foreach e $treecontents($prefix) {
- set path $prefix$e
- if {[highlight_tag $path] ne {}} {
- $cflist tag add bold $y.0 "$y.0 lineend"
+ foreach e $treecontents($prefix) {
+ set path $prefix$e
+ if {[highlight_tag $path] ne {}} {
+ $cflist tag add bold $y.0 "$y.0 lineend"
+ }
+ incr y
+ if {[string index $e end] eq "/" && $treeheight($path) > 1} {
+ set y [highlight_tree $y $path]
+ }
}
- incr y
- if {[string index $e end] eq "/" && $treeheight($path) > 1} {
- set y [highlight_tree $y $path]
- }
- }
- return $y
+ return $y
}
proc treeclosedir {w dir} {
- global treediropen treeheight treeparent treeindex
+ global treediropen treeheight treeparent treeindex
- set ix $treeindex($dir)
- $w conf -state normal
- $w delete s:$ix e:$ix
- set treediropen($dir) 0
- $w image configure a:$ix -image tri-rt
- $w conf -state disabled
- set n [expr {1 - $treeheight($dir)}]
- while {$dir ne {}} {
- incr treeheight($dir) $n
- set dir $treeparent($dir)
- }
+ set ix $treeindex($dir)
+ $w conf -state normal
+ $w delete s:$ix e:$ix
+ set treediropen($dir) 0
+ $w image configure a:$ix -image tri-rt
+ $w conf -state disabled
+ set n [expr {1 - $treeheight($dir)}]
+ while {$dir ne {}} {
+ incr treeheight($dir) $n
+ set dir $treeparent($dir)
+ }
}
proc treeopendir {w dir} {
- global treediropen treeheight treeparent treecontents treeindex
+ global treediropen treeheight treeparent treecontents treeindex
- set ix $treeindex($dir)
- $w conf -state normal
- $w image configure a:$ix -image tri-dn
- $w mark set e:$ix s:$ix
- $w mark gravity e:$ix right
- set lev 0
- set str "\n"
- set n [llength $treecontents($dir)]
- for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
- incr lev
- append str "\t"
- incr treeheight($x) $n
- }
- foreach e $treecontents($dir) {
- set de $dir$e
- if {[string index $e end] eq "/"} {
- set iy $treeindex($de)
- $w mark set d:$iy e:$ix
- $w mark gravity d:$iy left
- $w insert e:$ix $str
- set treediropen($de) 0
- $w image create e:$ix -align center -image tri-rt -padx 1 \
- -name a:$iy
- $w insert e:$ix $e [highlight_tag $de]
- $w mark set s:$iy e:$ix
- $w mark gravity s:$iy left
- set treeheight($de) 1
- } else {
- $w insert e:$ix $str
- $w insert e:$ix $e [highlight_tag $de]
+ set ix $treeindex($dir)
+ $w conf -state normal
+ $w image configure a:$ix -image tri-dn
+ $w mark set e:$ix s:$ix
+ $w mark gravity e:$ix right
+ set lev 0
+ set str "\n"
+ set n [llength $treecontents($dir)]
+ for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
+ incr lev
+ append str "\t"
+ incr treeheight($x) $n
}
- }
- $w mark gravity e:$ix right
- $w conf -state disabled
- set treediropen($dir) 1
- set top [lindex [split [$w index @0,0] .] 0]
- set ht [$w cget -height]
- set l [lindex [split [$w index s:$ix] .] 0]
- if {$l < $top} {
- $w yview $l.0
- } elseif {$l + $n + 1 > $top + $ht} {
- set top [expr {$l + $n + 2 - $ht}]
+ foreach e $treecontents($dir) {
+ set de $dir$e
+ if {[string index $e end] eq "/"} {
+ set iy $treeindex($de)
+ $w mark set d:$iy e:$ix
+ $w mark gravity d:$iy left
+ $w insert e:$ix $str
+ set treediropen($de) 0
+ $w image create e:$ix -align center -image tri-rt -padx 1 \
+ -name a:$iy
+ $w insert e:$ix $e [highlight_tag $de]
+ $w mark set s:$iy e:$ix
+ $w mark gravity s:$iy left
+ set treeheight($de) 1
+ } else {
+ $w insert e:$ix $str
+ $w insert e:$ix $e [highlight_tag $de]
+ }
+ }
+ $w mark gravity e:$ix right
+ $w conf -state disabled
+ set treediropen($dir) 1
+ set top [lindex [split [$w index @0,0] .] 0]
+ set ht [$w cget -height]
+ set l [lindex [split [$w index s:$ix] .] 0]
if {$l < $top} {
- set top $l
+ $w yview $l.0
+ } elseif {$l + $n + 1 > $top + $ht} {
+ set top [expr {$l + $n + 2 - $ht}]
+ if {$l < $top} {
+ set top $l
+ }
+ $w yview $top.0
}
- $w yview $top.0
- }
}
proc treeclick {w x y} {
- global treediropen cmitmode ctext cflist cflist_top
+ global treediropen cmitmode ctext cflist cflist_top
- if {$cmitmode ne "tree"} return
- if {![info exists cflist_top]} return
- set l [lindex [split [$w index "@$x,$y"] "."] 0]
- $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
- $cflist tag add highlight $l.0 "$l.0 lineend"
- set cflist_top $l
- if {$l == 1} {
- $ctext yview 1.0
- return
- }
- set e [linetoelt $l]
- if {[string index $e end] ne "/"} {
- showfile $e
- } elseif {$treediropen($e)} {
- treeclosedir $w $e
- } else {
- treeopendir $w $e
- }
+ if {$cmitmode ne "tree"} return
+ if {![info exists cflist_top]} return
+ set l [lindex [split [$w index "@$x,$y"] "."] 0]
+ $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
+ $cflist tag add highlight $l.0 "$l.0 lineend"
+ set cflist_top $l
+ if {$l == 1} {
+ $ctext yview 1.0
+ return
+ }
+ set e [linetoelt $l]
+ if {[string index $e end] ne "/"} {
+ showfile $e
+ } elseif {$treediropen($e)} {
+ treeclosedir $w $e
+ } else {
+ treeopendir $w $e
+ }
}
proc setfilelist {id} {
- global treefilelist cflist jump_to_here
+ global treefilelist cflist jump_to_here
- treeview $cflist $treefilelist($id) 0
- if {$jump_to_here ne {}} {
- set f [lindex $jump_to_here 0]
- if {[lsearch -exact $treefilelist($id) $f] >= 0} {
- showfile $f
+ treeview $cflist $treefilelist($id) 0
+ if {$jump_to_here ne {}} {
+ set f [lindex $jump_to_here 0]
+ if {[lsearch -exact $treefilelist($id) $f] >= 0} {
+ showfile $f
+ }
}
- }
}
image create bitmap tri-rt -background black -foreground blue -data {
- #define tri-rt_width 13
- #define tri-rt_height 13
- static unsigned char tri-rt_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
- 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
- 0x00, 0x00};
+ #define tri-rt_width 13
+ #define tri-rt_height 13
+ static unsigned char tri-rt_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
+ 0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
+ 0x00, 0x00};
} -maskdata {
- #define tri-rt-mask_width 13
- #define tri-rt-mask_height 13
- static unsigned char tri-rt-mask_bits[] = {
- 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
- 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
- 0x08, 0x00};
+ #define tri-rt-mask_width 13
+ #define tri-rt-mask_height 13
+ static unsigned char tri-rt-mask_bits[] = {
+ 0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
+ 0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
+ 0x08, 0x00};
}
image create bitmap tri-dn -background black -foreground blue -data {
- #define tri-dn_width 13
- #define tri-dn_height 13
- static unsigned char tri-dn_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
- 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00};
+ #define tri-dn_width 13
+ #define tri-dn_height 13
+ static unsigned char tri-dn_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
+ 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00};
} -maskdata {
- #define tri-dn-mask_width 13
- #define tri-dn-mask_height 13
- static unsigned char tri-dn-mask_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
- 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00};
+ #define tri-dn-mask_width 13
+ #define tri-dn-mask_height 13
+ static unsigned char tri-dn-mask_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
+ 0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 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};
+ #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};
+ #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};
+ #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};
+ #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 "#00ff00" \
- -data $rectdata -maskdata $rectmask
+ -data $rectdata -maskdata $rectmask
image create bitmap reficon-R -background black -foreground "#ffddaa" \
- -data $rectdata -maskdata $rectmask
+ -data $rectdata -maskdata $rectmask
image create bitmap reficon-o -background black -foreground "#ddddff" \
- -data $rectdata -maskdata $rectmask
+ -data $rectdata -maskdata $rectmask
proc init_flist {first} {
- global cflist cflist_top difffilestart
+ global cflist cflist_top difffilestart
- $cflist conf -state normal
- $cflist delete 0.0 end
- if {$first ne {}} {
- $cflist insert end $first
- set cflist_top 1
- $cflist tag add highlight 1.0 "1.0 lineend"
- } else {
- unset -nocomplain cflist_top
- }
- $cflist conf -state disabled
- set difffilestart {}
+ $cflist conf -state normal
+ $cflist delete 0.0 end
+ if {$first ne {}} {
+ $cflist insert end $first
+ set cflist_top 1
+ $cflist tag add highlight 1.0 "1.0 lineend"
+ } else {
+ unset -nocomplain cflist_top
+ }
+ $cflist conf -state disabled
+ set difffilestart {}
}
proc highlight_tag {f} {
- global highlight_paths
+ global highlight_paths
- foreach p $highlight_paths {
- if {[string match $p $f]} {
- return "bold"
+ foreach p $highlight_paths {
+ if {[string match $p $f]} {
+ return "bold"
+ }
}
- }
- return {}
+ return {}
}
proc highlight_filelist {} {
- global cmitmode cflist
+ global cmitmode cflist
- $cflist conf -state normal
- if {$cmitmode ne "tree"} {
- set end [lindex [split [$cflist index end] .] 0]
- for {set l 2} {$l < $end} {incr l} {
- set line [$cflist get $l.0 "$l.0 lineend"]
- if {[highlight_tag $line] ne {}} {
- $cflist tag add bold $l.0 "$l.0 lineend"
- }
+ $cflist conf -state normal
+ if {$cmitmode ne "tree"} {
+ set end [lindex [split [$cflist index end] .] 0]
+ for {set l 2} {$l < $end} {incr l} {
+ set line [$cflist get $l.0 "$l.0 lineend"]
+ if {[highlight_tag $line] ne {}} {
+ $cflist tag add bold $l.0 "$l.0 lineend"
+ }
+ }
+ } else {
+ highlight_tree 2 {}
}
- } else {
- highlight_tree 2 {}
- }
- $cflist conf -state disabled
+ $cflist conf -state disabled
}
proc unhighlight_filelist {} {
- global cflist
+ global cflist
- $cflist conf -state normal
- $cflist tag remove bold 1.0 end
- $cflist conf -state disabled
+ $cflist conf -state normal
+ $cflist tag remove bold 1.0 end
+ $cflist conf -state disabled
}
proc add_flist {fl} {
- global cflist
+ global cflist
- $cflist conf -state normal
- foreach f $fl {
- $cflist insert end "\n"
- $cflist insert end $f [highlight_tag $f]
- }
- $cflist conf -state disabled
+ $cflist conf -state normal
+ foreach f $fl {
+ $cflist insert end "\n"
+ $cflist insert end $f [highlight_tag $f]
+ }
+ $cflist conf -state disabled
}
proc sel_flist {w x y} {
- global ctext difffilestart cflist cflist_top cmitmode
+ global ctext difffilestart cflist cflist_top cmitmode
- if {$cmitmode eq "tree"} return
- if {![info exists cflist_top]} return
- set l [lindex [split [$w index "@$x,$y"] "."] 0]
- $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
- $cflist tag add highlight $l.0 "$l.0 lineend"
- set cflist_top $l
- if {$l == 1} {
- $ctext yview 1.0
- } else {
- catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
- }
- suppress_highlighting_file_for_current_scrollpos
+ if {$cmitmode eq "tree"} return
+ if {![info exists cflist_top]} return
+ set l [lindex [split [$w index "@$x,$y"] "."] 0]
+ $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
+ $cflist tag add highlight $l.0 "$l.0 lineend"
+ set cflist_top $l
+ if {$l == 1} {
+ $ctext yview 1.0
+ } else {
+ catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
+ }
+ suppress_highlighting_file_for_current_scrollpos
}
proc pop_flist_menu {w X Y x y} {
- global ctext cflist cmitmode flist_menu flist_menu_file
- global treediffs diffids
+ glo