diff --git a/gitk-git/gitk b/gitk-git/gitk index abe4805ade..23d9dd1fe0 100755 --- a/gitk-git/gitk +++ b/gitk-git/gitk @@ -11,14 +11,14 @@ package require Tk proc hasworktree {} { return [expr {[exec git rev-parse --is-bare-repository] == "false" && - [exec git rev-parse --is-inside-git-dir] == "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] + set n [string range $n 0 end-5] } return [file tail $n] } @@ -26,7 +26,7 @@ proc reponame {} { proc gitworktree {} { variable _gitworktree if {[info exists _gitworktree]} { - return $_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]}]} { @@ -34,10 +34,9 @@ proc gitworktree {} { # 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]] - } + if {[catch {set _gitworktree [exec git config --get core.worktree]}]} { + set _gitworktree [file normalize ./[exec git rev-parse --show-cdup]] + } } } return $_gitworktree @@ -54,7 +53,7 @@ proc run args { set script $args if {[info exists isonrunq($script)]} return if {$runq eq {} && ![info exists currunq]} { - after idle dorunq + after idle dorunq } lappend runq [list {} $script] set isonrunq($script) 1 @@ -69,7 +68,7 @@ proc filereadable {fd script} { fileevent $fd readable {} if {$runq eq {} && ![info exists currunq]} { - after idle dorunq + after idle dorunq } lappend runq [list $fd $script] } @@ -78,11 +77,11 @@ proc nukefile {fd} { 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 - } + if {[lindex $runq $i 0] eq $fd} { + set runq [lreplace $runq $i $i] + } else { + incr i + } } } @@ -92,30 +91,30 @@ proc dorunq {} { 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 + 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 + after idle dorunq } } @@ -135,20 +134,20 @@ proc unmerged_files {files} { set mlist {} set nr_unmerged 0 if {[catch { - set fd [open "| git ls-files -u" r] + set fd [open "| git ls-files -u" r] } err]} { - show_error {} . "[mc "Couldn't get list of unmerged files:"] $err" - exit 1 + 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 - } + 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 @@ -171,115 +170,115 @@ proc parseviewargs {n arglist} { 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 - - 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 - } - } + 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 - + 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 @@ -293,61 +292,61 @@ proc parseviewrevs {view revs} { global vposids vnegids if {$revs eq {}} { - set revs HEAD + set revs HEAD } elseif {[lsearch -exact $revs --all] >= 0} { - lappend revs HEAD + 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 - } - } - error_popup "[mc "Error parsing revisions:"] $err" - return {} + # 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 + } + } + 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 - } - } - 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 + 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 + } + incr sdm -1 } set vposids($view) $pos set vnegids($view) $neg @@ -374,63 +373,63 @@ proc start_rev_list {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"]] + 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 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] + set revs [parseviewrevs $view $vrevs($view)] + if {$revs eq {}} { + return 0 + } + set args [concat $vflags($view) $revs] } else { - set args $vorigargs($view) + set args $vorigargs($view) } if {[catch { - set fd [open [concat | git log --no-color -z --pretty=raw $show_notes \ - --parents --boundary $args "--" $files] r] + 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 + 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 + get_viewmainhead $view } if {$showlocalchanges && $viewmainheadid($view) ne {}} { - interestedin $viewmainheadid($view) dodiffindex + interestedin $viewmainheadid($view) dodiffindex } fconfigure $fd -blocking 0 -translation lf -eofchar {} if {$tclencoding != {}} { - fconfigure $fd -encoding $tclencoding + fconfigure $fd -encoding $tclencoding } filerun $fd [list getcommitlines $fd $i $view 0] nowbusy $view [mc "Reading"] @@ -444,13 +443,13 @@ proc stop_instance {inst} { set fd $commfd($inst) catch { - set pid [pid $fd] + 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 @@ -462,7 +461,7 @@ proc stop_backends {} { global commfd foreach inst [array names commfd] { - stop_instance $inst + stop_instance $inst } } @@ -470,7 +469,7 @@ proc stop_rev_list {view} { global viewinstances foreach inst $viewinstances($view) { - stop_instance $inst + stop_instance $inst } set viewinstances($view) {} } @@ -479,11 +478,11 @@ proc reset_pending_select {selid} { global pending_select mainheadid selectheadid if {$selid ne {}} { - set pending_select $selid + set pending_select $selid } elseif {$selectheadid ne {}} { - set pending_select $selectheadid + set pending_select $selectheadid } else { - set pending_select $mainheadid + set pending_select $mainheadid } } @@ -492,11 +491,11 @@ proc getcommits {selid} { initlayout if {[start_rev_list $curview]} { - reset_pending_select $selid - show_status [mc "Reading commits..."] - set need_redisplay 1 + reset_pending_select $selid + show_status [mc "Reading commits..."] + set need_redisplay 1 } else { - show_status [mc "No commits selected"] + show_status [mc "No commits selected"] } } @@ -513,67 +512,67 @@ proc updatecommits {} { 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} { + dohidelocalchanges + } + set viewmainheadid($view) $mainheadid + set viewmainheadid_orig($view) $mainheadid + if {$vfilelimit($view) ne {}} { + get_viewmainhead $view + } } if {$showlocalchanges} { - doshowlocalchanges + 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] + 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) + 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] + 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 + error_popup "[mc "Error executing git log:"] $err" + return } if {$viewactive($view) == 0} { - set startmsecs [clock clicks -milliseconds] + 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 + fconfigure $fd -encoding $tclencoding } filerun $fd [list getcommitlines $fd $i $view 1] incr viewactive($view) @@ -581,7 +580,7 @@ proc updatecommits {} { reset_pending_select {} nowbusy $view [mc "Reading"] if {$showneartags} { - getallcommits + getallcommits } } @@ -592,11 +591,11 @@ proc reloadcommits {} { set selid {} if {$selectedline ne {}} { - set selid $currentid + set selid $currentid } if {!$viewcomplete($curview)} { - stop_rev_list $curview + stop_rev_list $curview } resetvarcs $curview set selectedline {} @@ -606,7 +605,7 @@ proc reloadcommits {} { readrefs changedrefs if {$showneartags} { - getallcommits + getallcommits } clear_display unset -nocomplain commitinfo @@ -622,11 +621,11 @@ proc reloadcommits {} { # sorts as a string in numerical order proc strrep {n} { if {$n < 16} { - return [format "%x" $n] + return [format "%x" $n] } elseif {$n < 256} { - return [format "x%.2x" $n] + return [format "x%.2x" $n] } elseif {$n < 65536} { - return [format "y%.4x" $n] + return [format "y%.4x" $n] } return [format "z%.8x" $n] } @@ -657,22 +656,22 @@ proc resetvarcs {view} { global vshortids foreach vid [array names varcid $view,*] { - unset varcid($vid) - unset children($vid) - unset parents($vid) + unset varcid($vid) + unset children($vid) + unset parents($vid) } foreach vid [array names vshortids $view,*] { - unset vshortids($vid) + unset vshortids($vid) } # some commits might have children but haven't been seen yet foreach vid [array names children $view,*] { - unset children($vid) + unset children($vid) } foreach va [array names varccommits $view,*] { - unset varccommits($va) + unset varccommits($va) } foreach vd [array names vseedcount $view,*] { - unset vseedcount($vd) + unset vseedcount($vd) } unset -nocomplain ordertok } @@ -684,8 +683,8 @@ proc seeds {v} { set ret {} set a [lindex $vdownptr($v) 0] while {$a != 0} { - lappend ret [lindex $varcstart($v) $a] - set a [lindex $vleftptr($v) $a] + lappend ret [lindex $varcstart($v) $a] + set a [lindex $vleftptr($v) $a] } return $ret } @@ -698,60 +697,60 @@ proc newvarc {view id} { 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]" + 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 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 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 {$ka != 0} { - set i [lsearch -exact $parents($view,$ki) $id] - set j [expr {[llength $parents($view,$ki)] - 1 - $i}] - append tok [strrep $j] + 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] + set c $ka + set b [lindex $vdownptr($view) $ka] } else { - set b [lindex $vleftptr($view) $c] + 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] + set c $b + set b [lindex $vleftptr($view) $c] } if {$c == $ka} { - lset vdownptr($view) $ka $a - lappend vbackptr($view) 0 + lset vdownptr($view) $ka $a + lappend vbackptr($view) 0 } else { - lset vleftptr($view) $c $a - lappend vbackptr($view) $c + 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 + lset vbackptr($view) $b $a } lappend varctok($view) $tok lappend varcstart($view) $id @@ -782,7 +781,7 @@ proc splitvarc {p v} { set varccommits($v,$na) [lrange $ac $i end] lappend varcstart($v) $p foreach id $varccommits($v,$na) { - set varcid($v,$id) $na + set varcid($v,$id) $na } lappend vdownptr($v) [lindex $vdownptr($v) $oa] lappend vlastins($v) [lindex $vlastins($v) $oa] @@ -792,10 +791,10 @@ proc splitvarc {p v} { 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 + lset vupptr($v) $b $na } if {[string compare $otok $vtokmod($v)] <= 0} { - modify_arc $v $oa + modify_arc $v $oa } } @@ -809,120 +808,120 @@ proc renumbervarc {a v} { 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 + 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 } 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 - } + 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 + } } foreach id [array names sortkids] { - if {[llength $children($v,$id)] > 1} { - set children($v,$id) [lsort -command [list vtokcmp $v] \ - $children($v,$id)] - } + 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" @@ -936,14 +935,14 @@ proc fix_reversal {p a v} { set pa $varcid($v,$p) if {$p ne [lindex $varcstart($v) $pa]} { - splitvarc $p $v - set pa $varcid($v,$p) + 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 + [string compare [lindex $varctok($v) $a] \ + [lindex $varctok($v) $pa]] > 0} { + renumbervarc $pa $v } } @@ -961,24 +960,24 @@ proc insertrow {id p v} { 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 + 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 + 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 - } - } + set numcommits $commitidx($v) + setcanvscroll + if {[info exists targetid]} { + if {![comes_before $targetid $p]} { + incr targetrow + } + } } } @@ -990,8 +989,8 @@ proc insertfakerow {id p} { 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 + puts "oops: insertfakerow can't find [shortids $p] on arc $a" + return } set children($v,$id) {} set parents($v,$id) [list $p] @@ -1003,9 +1002,9 @@ proc insertfakerow {id p} { 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 - } + if {![comes_before $targetid $p]} { + incr targetrow + } } setcanvscroll drawvisible @@ -1018,15 +1017,15 @@ proc removefakerow {id} { set v $curview if {[llength $parents($v,$id)] != 1} { - puts "oops: removefakerow [shortids $id] has [llength $parents($v,$id)] parents" - return + 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 + 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] @@ -1036,15 +1035,15 @@ proc removefakerow {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] + 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 {} + unset currentid + set selectedline {} } if {[info exists targetid] && $targetid eq $id} { - set targetid $p + set targetid $p } setcanvscroll drawvisible @@ -1055,9 +1054,9 @@ proc real_children {vp} { set kids {} foreach id $children($vp) { - if {$id ne $nullid && $id ne $nullid2} { - lappend kids $id - } + if {$id ne $nullid && $id ne $nullid2} { + lappend kids $id + } } return $kids } @@ -1066,9 +1065,9 @@ proc first_real_child {vp} { global children nullid nullid2 foreach id $children($vp) { - if {$id ne $nullid && $id ne $nullid2} { - return $id - } + if {$id ne $nullid && $id ne $nullid2} { + return $id + } } return {} } @@ -1078,10 +1077,10 @@ proc last_real_child {vp} { 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 id [lindex $kids $i] + if {$id ne $nullid && $id ne $nullid2} { + return $id + } } return {} } @@ -1090,7 +1089,7 @@ proc vtokcmp {v a b} { global varctok varcid return [string compare [lindex $varctok($v) $varcid($v,$a)] \ - [lindex $varctok($v) $varcid($v,$b)]] + [lindex $varctok($v) $varcid($v,$b)]] } # This assumes that if lim is not given, the caller has checked that @@ -1099,29 +1098,29 @@ proc modify_arc {v a {lim {}}} { 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 - } + 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 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 + 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 } } @@ -1133,62 +1132,62 @@ proc update_arcrows {v} { 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 + 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 } 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] + # 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 + 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] + 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 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] + set selectedline [rowofcommit $currentid] } } @@ -1206,20 +1205,20 @@ proc rowofcommit {id} { set v $curview if {![info exists varcid($v,$id)]} { - puts "oops rowofcommit no arc for [shortids $id]" - return {} + 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 + update_arcrows $v } if {[info exists cached_commitrow($id)]} { - return $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 {} + puts "oops didn't find commit [shortids $id] in arc $a" + return {} } incr i [lindex $varcrow($v) $a] set cached_commitrow($id) $i @@ -1232,32 +1231,32 @@ proc comes_before {a b} { set v $curview if {$a eq $b || ![info exists varcid($v,$a)] || \ - ![info exists varcid($v,$b)]} { - return 0 + ![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 {[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 + 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 - } + 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 } @@ -1269,37 +1268,37 @@ proc make_disporder {start end} { global d_valid_start d_valid_end if {$end > $vrowmod($curview)} { - update_arcrows $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 + 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 } } @@ -1308,8 +1307,8 @@ proc commitonrow {row} { set id [lindex $displayorder $row] if {$id eq {}} { - make_disporder $row [expr {$row + 1}] - set id [lindex $displayorder $row] + make_disporder $row [expr {$row + 1}] + set id [lindex $displayorder $row] } return $id } @@ -1322,35 +1321,35 @@ proc closevarcs {v} { 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 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 - } + foreach s $scripts { + eval $s + } } } @@ -1360,23 +1359,23 @@ proc rewrite_commit {v id rwid} { 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" - } - 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}] + # 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}] } } @@ -1396,19 +1395,19 @@ proc check_interest {id scripts} { 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) - } + 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) + } } return $scripts } @@ -1423,192 +1422,192 @@ proc getcommitlines {fd inst view updating} { 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" + set stuff "\0" } if {$stuff == {}} { - if {![eof $fd]} { - return 1 - } - 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.)" - } - } 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 + if {![eof $fd]} { + return 1 + } + 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.)" + } + } 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} - } - 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 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} + } + 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 - lappend vshortids($view,[string range $id 0 3]) $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 {!$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 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 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 + set scripts [check_interest $id $scripts] + set gotsome 1 } if {$gotsome} { - global numcommits hlview + 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 - } + 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 + } } return 2 } @@ -1619,28 +1618,28 @@ proc chewcommits {} { layoutmore if {$viewcomplete($curview)} { - global commitidx varctok - global numcommits startmsecs + 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 {$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 {[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 } return 0 } @@ -1653,7 +1652,7 @@ proc do_readcommit {id} { # Read the results using i18n.logoutputencoding fconfigure $fd -translation lf -eofchar {} if {$tclencoding != {}} { - fconfigure $fd -encoding $tclencoding + fconfigure $fd -encoding $tclencoding } set contents [read $fd] close $fd @@ -1680,44 +1679,44 @@ proc parsecommit {id contents listed} { set comdate {} set hdrend [string first "\n\n" $contents] if {$hdrend < 0} { - # should never happen... - set hdrend [string length $contents] + # 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 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 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 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]] + 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 + # 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 "" @@ -1726,23 +1725,23 @@ proc parsecommit {id contents listed} { # 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 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] + $comname $comdate $comment $hasnote $diff] } proc getcommit {id} { global commitdata commitinfo if {[info exists commitdata($id)]} { - parsecommit $id $commitdata($id) 1 + parsecommit $id $commitdata($id) 1 } else { - readcommit $id - if {![info exists commitinfo($id)]} { - set commitinfo($id) [list [mc "No commit information available"]] - } + readcommit $id + if {![info exists commitinfo($id)]} { + set commitinfo($id) [list [mc "No commit information available"]] + } } return 1 } @@ -1755,22 +1754,22 @@ proc longid {prefix} { 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 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 - } + foreach match [array names varcid "$curview,$prefix*"] { + lappend ids [lindex [split $match ","] 1] + if {[llength $ids] >= 2} break + } } return $ids } @@ -1780,57 +1779,61 @@ proc readrefs {} { global otherrefids idotherrefs mainhead mainheadid global selecthead selectheadid global hideremotes + global tclencoding foreach v {tagids idtags headids idheads otherrefids idotherrefs} { - unset -nocomplain $v + 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 - } + 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 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 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] - } + catch { + set selectheadid [exec git rev-parse --verify $selecthead] + } } } @@ -1839,10 +1842,10 @@ proc first_real_row {} { global nullid nullid2 numcommits for {set row 0} {$row < $numcommits} {incr row} { - set id [commitonrow $row] - if {$id ne $nullid && $id ne $nullid2} { - break - } + set id [commitonrow $row] + if {$id ne $nullid && $id ne $nullid2} { + break + } } return $row } @@ -1861,12 +1864,12 @@ proc removehead {id name} { global headids idheads if {$idheads($id) eq $name} { - unset idheads($id) + unset idheads($id) } else { - set i [lsearch -exact $idheads($id) $name] - if {$i >= 0} { - set idheads($id) [lreplace $idheads($id) $i $i] - } + set i [lsearch -exact $idheads($id) $name] + if {$i >= 0} { + set idheads($id) [lreplace $idheads($id) $i $i] + } } unset headids($name) } @@ -1894,7 +1897,7 @@ proc make_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] + after idle [list tk::PlaceWindow $window widget $origin] } } @@ -1994,41 +1997,41 @@ proc setttkstyle {} { proc makemenu {m items} { menu $m if {[tk windowingsystem] eq {aqua}} { - set Meta1 Cmd + set Meta1 Cmd } else { - set Meta1 Ctrl + 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 - } - } - 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 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 + } } } @@ -2048,12 +2051,12 @@ proc makedroplist {w varname 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 <> [list $gm selection clear] + set gm [ttk::combobox $w -width $width -state readonly\ + -textvariable $varname -values $args \ + -exportselection false] + bind $gm <> [list $gm selection clear] } else { - set gm [eval [linsert $args 0 tk_optionMenu $w $varname]] + set gm [eval [linsert $args 0 tk_optionMenu $w $varname]] } return $gm } @@ -2069,7 +2072,7 @@ proc makewindow {} { global rowctxmenu fakerowmenu mergemax wrapcomment global highlight_files gdttype global searchstring sstring - global bgcolor fgcolor bglist fglist diffcolors selectbgcolor + global bgcolor fgcolor bglist fglist diffcolors diffbgcolors selectbgcolor global uifgcolor uifgdisabledcolor global filesepbgcolor filesepfgcolor global mergecolors foundbgcolor currentsearchhitbgcolor @@ -2083,49 +2086,49 @@ proc makewindow {} { # 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} - }} + 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} - }} + 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}} - }} + 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] + 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] + 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 @@ -2153,36 +2156,36 @@ proc makewindow {} { ${NS}::frame .tf.histframe ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal if {!$use_ttk} { - .tf.histframe.pwclist configure -sashpad 0 -handlesize 4 + .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" + -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 + -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 + -selectbackground $selectbgcolor \ + -background $bgcolor -bd 0 -yscrollincr $linespc .tf.histframe.pwclist add $canv3 if {$use_ttk} { - bind .tf.histframe.pwclist { - bind %W {} - .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0] - .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0] - } + bind .tf.histframe.pwclist { + bind %W {} + .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) + eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0) + eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1) } # a scroll bar to rule them @@ -2201,7 +2204,7 @@ proc makewindow {} { set entries $sha1entry set sha1but .tf.bar.sha1label button $sha1but -text "[mc "SHA1 ID:"] " -state disabled -relief flat \ - -command gotocommit -width 8 + -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 @@ -2209,20 +2212,20 @@ proc makewindow {} { 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}; + #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}; + #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 @@ -2231,28 +2234,28 @@ proc makewindow {} { ${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] + .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray] } else { - .tf.bar.leftbut configure -image bm-left + .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] + .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray] } else { - .tf.bar.rightbut configure -image bm-right + .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 + -relief sunken -anchor e ${NS}::label .tf.bar.rowlabel2 -text "/" ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \ - -relief sunken -anchor e + -relief sunken -anchor e pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \ - -side left + -side left if {!$use_ttk} { foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont} } @@ -2264,14 +2267,14 @@ proc makewindow {} { ${NS}::label $statusw -width 15 -relief sunken pack $statusw -side left -padx 5 if {$use_ttk} { - set progresscanv [ttk::progressbar .tf.bar.progress] + 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] + 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} @@ -2285,26 +2288,26 @@ proc makewindow {} { ${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}; + #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}; + #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} @@ -2313,13 +2316,13 @@ proc makewindow {} { ${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 + -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:"]] + [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 @@ -2330,11 +2333,11 @@ proc makewindow {} { trace add variable findstring write find_change set findtype [mc "Exact"] set findtypemenu [makedroplist .tf.lbar.findtype \ - findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]] + 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"] + [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 @@ -2346,8 +2349,8 @@ proc makewindow {} { 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) + .ctop paneconfigure .tf -height $geometry(topheight) + .ctop paneconfigure .tf -width $geometry(topwidth) } # now build up the bottom @@ -2357,9 +2360,9 @@ proc makewindow {} { # 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) + ${NS}::frame .bleft -width $geometry(botwidth) } else { - ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight) + ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight) } ${NS}::frame .bleft.top ${NS}::frame .bleft.mid @@ -2377,41 +2380,41 @@ proc makewindow {} { 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} + -command changediffdisp -variable diffelide -value {0 0} ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \ - -command changediffdisp -variable diffelide -value {0 1} + -command changediffdisp -variable diffelide -value {0 1} ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \ - -command changediffdisp -variable diffelide -value {1 0} + -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 + -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 + -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 + 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" + -state disabled -undo 0 -font textfont \ + -yscrollcommand scrolltext -wrap none \ + -xscrollcommand ".bleft.bottom.sbhorizontal set" if {$have_tk85} { - $ctext conf -tabstyle wordprocessor + $ctext conf -tabstyle wordprocessor } ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview" ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h @@ -2430,7 +2433,9 @@ proc makewindow {} { $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 d0 -back [lindex $diffbgcolors 0] $ctext tag conf dresult -fore [lindex $diffcolors 1] + $ctext tag conf dresult -back [lindex $diffbgcolors 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] @@ -2455,38 +2460,44 @@ proc makewindow {} { $ctext tag conf currentsearchhit -back $currentsearchhitbgcolor $ctext tag conf wwrap -wrap word -lmargin2 1c $ctext tag conf bold -font textfontbold + # set these to the lowest priority: + $ctext tag lower currentsearchhit + $ctext tag lower found + $ctext tag lower filesep + $ctext tag lower dresult + $ctext tag lower d0 .pwbottom add .bleft if {!$use_ttk} { - .pwbottom paneconfigure .bleft -width $geometry(botwidth) + .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" + -command reselectline -variable cmitmode -value "patch" ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \ - -command reselectline -variable cmitmode -value "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 + -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] + -background [$cflist cget -selectbackground] $cflist tag configure bold -font mainfontbold .pwbottom add .bright @@ -2494,15 +2505,15 @@ proc makewindow {} { # 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 {[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"} { @@ -2526,25 +2537,25 @@ proc makewindow {} { bind %W {} %W sashpos 0 $::geometry(botwidth) } + bind .pwbottom {resizecdetpanes %W %w} } - bind .pwbottom {resizecdetpanes %W %w} pack .ctop -fill both -expand 1 bindall <1> {selcanvline %W %x %y} #bindall {selcanvline %W %x %y} if {[tk windowingsystem] == "win32"} { - bind . { windows_mousewheel_redirector %W %X %Y %D } - bind $ctext { windows_mousewheel_redirector %W %X %Y %D ; break } + bind . { windows_mousewheel_redirector %W %X %Y %D } + bind $ctext { windows_mousewheel_redirector %W %X %Y %D ; break } } else { - bindall "allcanvs yview scroll -5 units" - bindall "allcanvs yview scroll 5 units" - bind $ctext