diff options
Diffstat (limited to 'gitk-git/gitk')
| -rwxr-xr-x[-rw-r--r--] | gitk-git/gitk | 3743 |
1 files changed, 2835 insertions, 908 deletions
diff --git a/gitk-git/gitk b/gitk-git/gitk index fddcb45817..22270ce46b 100644..100755 --- a/gitk-git/gitk +++ b/gitk-git/gitk @@ -2,18 +2,45 @@ # Tcl ignores the next line -*- tcl -*- \ exec wish "$0" -- "$@" -# Copyright © 2005-2008 Paul Mackerras. All rights reserved. +# Copyright © 2005-2011 Paul Mackerras. All rights reserved. # This program is free software; it may be used, copied, modified # and distributed under the terms of the GNU General Public Licence, # either version 2, or (at your option) any later version. -proc gitdir {} { - global env - if {[info exists env(GIT_DIR)]} { - return $env(GIT_DIR) - } else { - return [exec git rev-parse --git-dir] +package require Tk + +proc hasworktree {} { + 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] +} + +proc 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 } # A simple scheduler for compute-intensive stuff. @@ -22,11 +49,11 @@ proc gitdir {} { # run before X event handlers, so reading from a fast source can # make the GUI completely unresponsive. proc run args { - global isonrunq runq + global isonrunq runq currunq set script $args if {[info exists isonrunq($script)]} return - if {$runq eq {}} { + if {$runq eq {} && ![info exists currunq]} { after idle dorunq } lappend runq [list {} $script] @@ -38,10 +65,10 @@ proc filerun {fd script} { } proc filereadable {fd script} { - global runq + global runq currunq fileevent $fd readable {} - if {$runq eq {}} { + if {$runq eq {} && ![info exists currunq]} { after idle dorunq } lappend runq [list $fd $script] @@ -60,17 +87,19 @@ proc nukefile {fd} { } proc dorunq {} { - global isonrunq runq + 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}] - set runq [lrange $runq 1 end] if {$repeat ne {} && $repeat} { if {$fd eq {} || $repeat == 2} { # script returns 1 if it wants to be readded @@ -90,6 +119,15 @@ proc dorunq {} { } } +proc reg_instance {fd} { + global commfd leftover loginstance + + set i [incr loginstance] + set commfd($i) $fd + set leftover($i) {} + return $i +} + proc unmerged_files {files} { global nr_unmerged @@ -117,7 +155,8 @@ proc unmerged_files {files} { } proc parseviewargs {n arglist} { - global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs + global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env + global worddiff git_version set vdatemode($n) 0 set vmergeonly($n) 0 @@ -144,55 +183,64 @@ proc parseviewargs {n arglist} { set origargs [lreplace $origargs $i $i] incr i -1 } - # These request or affect diff output, which we don't want. - # Some could be used to set our defaults for diff display. "-[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 } - # These cause our parsing of git log's output to fail, or else - # they're options we want to set ourselves, so ignore them. "--raw" - "--patch-with-raw" - "--patch-with-stat" - - "--name-only" - "--name-status" - "--color" - "--color-words" - + "--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"] + } } - # These are harmless, and some are even useful "--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 } - # These mean that we get a subset of the commits "--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*" - "--pickaxe-all" - "--pickaxe-regex" - { + "-S*" - "--pickaxe-all" - "--pickaxe-regex" - + "--simplify-by-decoration" { + # These mean that we get a subset of the commits set filtered 1 lappend glflags $arg } - # This appears to be the only one that has a value as a - # separate word following it "-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" { - set notflag [expr {!$notflag}] - lappend revargs $arg - } - "--all" { + "--not" - "--all" { lappend revargs $arg } "--merge" { @@ -200,8 +248,11 @@ proc parseviewargs {n arglist} { # git rev-parse doesn't understand --merge lappend revargs --gitk-symmetric-diff-marker MERGE_HEAD...HEAD } - # Other flag arguments including -<n> + "--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 { @@ -211,8 +262,8 @@ proc parseviewargs {n arglist} { } lappend glflags $arg } - # Non-flag arguments specify commits or ranges of commits default { + # Non-flag arguments specify commits or ranges of commits if {[string match "*...*" $arg]} { lappend revargs --gitk-symmetric-diff-marker } @@ -257,8 +308,8 @@ proc parseviewrevs {view revs} { } lappend badrev $line } - } - error_popup "Error parsing revisions: $err" + } + error_popup "[mc "Error parsing revisions:"] $err" return {} } set ret {} @@ -280,7 +331,7 @@ proc parseviewrevs {view revs} { if {$sdm != 2} { lappend ret $id } else { - lset ret end [lindex $ret end]...$id + lset ret end $id...[lindex $ret end] } lappend pos $id } @@ -294,12 +345,13 @@ proc parseviewrevs {view revs} { # Start off a git log process and arrange to read its output proc start_rev_list {view} { global startmsecs commitidx viewcomplete curview - global commfd leftover tclencoding + global tclencoding global viewargs viewargscmd viewfiles vfilelimit - global showlocalchanges commitinterest - global viewactive loginstance viewinstances vmergeonly - global pending_select mainheadid + 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 @@ -313,7 +365,7 @@ proc start_rev_list {view} { if {[catch { set str [exec sh -c $viewargscmd($view)] } err]} { - error_popup "Error executing --argscmd command: $err" + error_popup "[mc "Error executing --argscmd command:"] $err" return 0 } set args [concat $args [split $str "\n"]] @@ -348,18 +400,21 @@ proc start_rev_list {view} { } if {[catch { - set fd [open [concat | git log --no-color -z --pretty=raw --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 } - set i [incr loginstance] + set i [reg_instance $fd] set viewinstances($view) [list $i] - set commfd($i) $fd - set leftover($i) {} - if {$showlocalchanges && $mainheadid ne {}} { - lappend commitinterest($mainheadid) {dodiffindex} + 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 != {}} { @@ -367,36 +422,65 @@ proc start_rev_list {view} { } filerun $fd [list getcommitlines $fd $i $view 0] nowbusy $view [mc "Reading"] - if {$view == $curview} { - set pending_select $mainheadid - } set viewcomplete($view) 0 set viewactive($view) 1 return 1 } -proc stop_rev_list {view} { - global commfd viewinstances leftover +proc stop_instance {inst} { + global commfd leftover - foreach inst $viewinstances($view) { - 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 kill -f $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 + + foreach inst [array names commfd] { + stop_instance $inst + } +} + +proc stop_rev_list {view} { + global viewinstances + + foreach inst $viewinstances($view) { + stop_instance $inst } set viewinstances($view) {} } -proc getcommits {} { +proc reset_pending_select {selid} { + global pending_select mainheadid selectheadid + + 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 initlayout if {[start_rev_list $curview]} { + reset_pending_select $selid show_status [mc "Reading commits..."] set need_redisplay 1 } else { @@ -406,24 +490,29 @@ proc getcommits {} { proc updatecommits {} { global curview vcanopt vorigargs vfilelimit viewinstances - global viewactive viewcomplete loginstance tclencoding - global startmsecs commfd showneartags showlocalchanges leftover - global mainheadid pending_select - global isworktree + 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 isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}] - set oldmainid $mainheadid + set hasworktree [hasworktree] rereadrefs - if {$showlocalchanges} { - if {$mainheadid ne $oldmainid} { + set view $curview + if {$mainheadid ne $viewmainheadid_orig($view)} { + if {$showlocalchanges} { dohidelocalchanges } - if {[commitinview $mainheadid $curview]} { - dodiffindex + set viewmainheadid($view) $mainheadid + set viewmainheadid_orig($view) $mainheadid + if {$vfilelimit($view) ne {}} { + get_viewmainhead $view } } - set view $curview + if {$showlocalchanges} { + doshowlocalchanges + } if {$vcanopt($view)} { set oldpos $vposids($view) set oldneg $vnegids($view) @@ -459,19 +548,17 @@ proc updatecommits {} { set args $vorigargs($view) } if {[catch { - set fd [open [concat | git log --no-color -z --pretty=raw --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 "Error executing git log: $err" + error_popup "[mc "Error executing git log:"] $err" return } if {$viewactive($view) == 0} { set startmsecs [clock clicks -milliseconds] } - set i [incr loginstance] + set i [reg_instance $fd] lappend viewinstances($view) $i - set commfd($i) $fd - set leftover($i) {} fconfigure $fd -blocking 0 -translation lf -eofchar {} if {$tclencoding != {}} { fconfigure $fd -encoding $tclencoding @@ -479,8 +566,8 @@ proc updatecommits {} { filerun $fd [list getcommitlines $fd $i $view 1] incr viewactive($view) set viewcomplete($view) 0 - set pending_select $mainheadid - nowbusy $view "Reading" + reset_pending_select {} + nowbusy $view [mc "Reading"] if {$showneartags} { getallcommits } @@ -491,6 +578,11 @@ proc reloadcommits {} { global showneartags treediffs commitinterest cached_commitrow global targetid + set selid {} + if {$selectedline ne {}} { + set selid $currentid + } + if {!$viewcomplete($curview)} { stop_rev_list $curview } @@ -509,7 +601,7 @@ proc reloadcommits {} { catch {unset cached_commitrow} catch {unset targetid} setcanvscroll - getcommits + getcommits $selid return 0 } @@ -549,12 +641,16 @@ proc varcinit {view} { proc resetvarcs {view} { 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) @@ -592,7 +688,7 @@ proc newvarc {view id} { if {![info exists commitinfo($id)]} { parsecommit $id $commitdata($id) 1 } - set cdate [lindex $commitinfo($id) 4] + set cdate [lindex [lindex $commitinfo($id) 4] 0] if {![string is integer -strict $cdate]} { set cdate 0 } @@ -655,16 +751,17 @@ proc newvarc {view id} { } proc splitvarc {p v} { - global varcid varcstart varccommits varctok + 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 "[lindex $varctok($v) $oa]%[strrep $i]" + set tok "$otok%[strrep $i]" lappend varctok($v) $tok lappend varcrow($v) {} lappend varcix($v) {} @@ -684,6 +781,9 @@ proc splitvarc {p v} { 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} { @@ -837,7 +937,7 @@ proc fix_reversal {p a v} { proc insertrow {id p v} { global cmitlisted children parents varcid varctok vtokmod global varccommits ordertok commitidx numcommits curview - global targetid targetrow + global targetid targetrow vshortids readcommit $id set vid $v,$id @@ -846,6 +946,7 @@ proc insertrow {id p v} { 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 } @@ -936,6 +1037,18 @@ proc removefakerow {id} { drawvisible } +proc real_children {vp} { + global children nullid nullid2 + + set kids {} + foreach id $children($vp) { + if {$id ne $nullid && $id ne $nullid2} { + lappend kids $id + } + } + return $kids +} + proc first_real_child {vp} { global children nullid nullid2 @@ -1190,7 +1303,7 @@ proc commitonrow {row} { proc closevarcs {v} { global varctok varccommits varcid parents children - global cmitlisted commitidx commitinterest vtokmod + global cmitlisted commitidx vtokmod set missing_parents 0 set scripts {} @@ -1215,12 +1328,7 @@ proc closevarcs {v} { } lappend varccommits($v,$b) $p incr commitidx($v) - if {[info exists commitinterest($p)]} { - foreach script $commitinterest($p) { - lappend scripts [string map [list "%I" $p] $script] - } - unset commitinterest($id) - } + set scripts [check_interest $p $scripts] } } if {$missing_parents > 0} { @@ -1256,12 +1364,45 @@ proc rewrite_commit {v id rwid} { } } +# 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 +# list of id, cmd pairs. +proc interestedin {id cmd} { + global commitinterest + + lappend commitinterest([string range $id 0 3]) $id $cmd +} + +proc check_interest {id scripts} { + 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 + } + } + if {$newlist ne {}} { + set commitinterest($prefix) $newlist + } else { + unset commitinterest($prefix) + } + } + return $scripts +} + proc getcommitlines {fd inst view updating} { - global cmitlisted commitinterest leftover + global cmitlisted leftover global commitidx commitdata vdatemode global parents children curview hlview global idpending ordertok - global varccommits varcid varctok vtokmod vfilelimit + global varccommits varcid varctok vtokmod vfilelimit vshortids set stuff [read $fd 500000] # git log doesn't terminate the last commit with a null... @@ -1361,6 +1502,8 @@ proc getcommitlines {fd inst view updating} { 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 @@ -1433,12 +1576,7 @@ proc getcommitlines {fd inst view updating} { incr i } - if {[info exists commitinterest($id)]} { - foreach script $commitinterest($id) { - lappend scripts [string map [list "%I" $id] $script] - } - unset commitinterest($id) - } + set scripts [check_interest $id $scripts] set gotsome 1 } if {$gotsome} { @@ -1469,8 +1607,15 @@ proc chewcommits {} { global numcommits startmsecs if {[info exists pending_select]} { - set row [first_real_row] - selectline $row 1 + 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}] @@ -1484,13 +1629,31 @@ proc chewcommits {} { return 0 } +proc do_readcommit {id} { + 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 + + return $contents +} + proc readcommit {id} { - if {[catch {set contents [exec git cat-file commit $id]}]} return - parsecommit $id $contents 0 + if {[catch {set contents [do_readcommit $id]}]} return + parsecommit $id $contents 1 } proc parsecommit {id contents listed} { - global commitinfo cdate + global commitinfo set inhdr 1 set comment {} @@ -1507,13 +1670,14 @@ proc parsecommit {id contents listed} { 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 [lindex $line end-1] - set auname [lrange $line 1 end-2] + set audate [lrange $line end-1 end] + set auname [join [lrange $line 1 end-2] " "] } elseif {$tag == "committer"} { - set comdate [lindex $line end-1] - set comname [lrange $line 1 end-2] + set comdate [lrange $line end-1 end] + set comname [join [lrange $line 1 end-2] " "] } } set headline {} @@ -1539,11 +1703,9 @@ proc parsecommit {id contents listed} { } set comment $newcomment } - if {$comdate != {}} { - set cdate($id) $comdate - } + set hasnote [string first "\nNotes:\n" $contents] set commitinfo($id) [list $headline $auname $audate \ - $comname $comdate $comment] + $comname $comdate $comment $hasnote] } proc getcommit {id} { @@ -1560,9 +1722,39 @@ proc getcommit {id} { 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 + + 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 + } + } + return $ids +} + proc readrefs {} { global tagids idtags headids idheads tagobjid global otherrefids idotherrefs mainhead mainheadid + global selecthead selectheadid + global hideremotes foreach v {tagids idtags headids idheads otherrefids idotherrefs} { catch {unset $v} @@ -1575,7 +1767,7 @@ proc readrefs {} { if {![string match "refs/*" $ref]} continue set name [string range $ref 5 end] if {[string match "remotes/*" $name]} { - if {![string match "*/HEAD" $name]} { + if {![string match "*/HEAD" $name] && !$hideremotes} { set headids($name) $id lappend idheads($id) $name } @@ -1609,6 +1801,12 @@ proc readrefs {} { 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 @@ -1648,51 +1846,172 @@ proc removehead {id name} { unset headids($name) } -proc show_error {w top msg} { +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 +} + +proc make_transient {window origin} { + 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 + + 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] + } +} + +proc show_error {w top msg {mc mc}} { + 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 - button $w.ok -text [mc OK] -command "destroy $top" + ${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 { - set w .error - toplevel $w - wm transient $w . - show_error $w $w $msg +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 + } } -proc confirm_popup msg { - global confirm_ok +proc confirm_popup {msg {owner .}} { + global confirm_ok NS set confirm_ok 0 set w .confirm - toplevel $w - wm transient $w . + 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 - button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w" + ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w" pack $w.ok -side left -fill x - button $w.cancel -text [mc Cancel] -command "destroy $w" + ${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 {} { - option add *Panedwindow.showHandle 1 startupFile - option add *Panedwindow.sashRelief raised 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 *Menu.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 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 +} + +# Make a menu and submenus. +# m is the window name for the menu, items is the list of menu items to add. +# Each item is a list {mc label type description options...} +# mc is ignored; it's so we can put mc there to alert xgettext +# label is the string that appears in the menu +# type is cascade, command or radiobutton (should add checkbutton) +# 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 + } + } + 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 + } + } +} + +# translate string and remove ampersands +proc mca {str} { + return [string map {&& & & {}} [mc $str]] +} + +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] + } else { + set gm [eval [linsert $args 0 tk_optionMenu $w $varname]] + } + return $gm } proc makewindow {} { @@ -1710,39 +2029,67 @@ proc makewindow {} { global headctxmenu progresscanv progressitem progresscoords statusw global fprogitem fprogcoord lastprogupdate progupdatepending global rprogitem rprogcoord rownumsel numcommits - global have_tk85 - - menu .bar - .bar add cascade -label [mc "File"] -menu .bar.file - menu .bar.file - .bar.file add command -label [mc "Update"] -command updatecommits - .bar.file add command -label [mc "Reload"] -command reloadcommits - .bar.file add command -label [mc "Reread references"] -command rereadrefs - .bar.file add command -label [mc "List references"] -command showrefs - .bar.file add command -label [mc "Quit"] -command doquit - menu .bar.edit - .bar add cascade -label [mc "Edit"] -menu .bar.edit - .bar.edit add command -label [mc "Preferences"] -command doprefs - - menu .bar.view - .bar add cascade -label [mc "View"] -menu .bar.view - .bar.view add command -label [mc "New view..."] -command {newview 0} - .bar.view add command -label [mc "Edit view..."] -command editview \ - -state disabled - .bar.view add command -label [mc "Delete view"] -command delview -state disabled - .bar.view add separator - .bar.view add radiobutton -label [mc "All files"] -command {showview 0} \ - -variable selectedview -value 0 - - menu .bar.help - .bar add cascade -label [mc "Help"] -menu .bar.help - .bar.help add command -label [mc "About gitk"] -command about - .bar.help add command -label [mc "Key bindings"] -command keys - .bar.help configure + 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 Meta1-F5} + {mc "Reread references" 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. - panedwindow .ctop -orient vertical + ${NS}::panedwindow .ctop -orient vertical # possibly use assumed geometry if {![info exists geometry(pwsash0)]} { @@ -1750,14 +2097,17 @@ proc makewindow {} { set geometry(topwidth) [expr {80 * $charspc}] set geometry(botheight) [expr {15 * $linespc}] set geometry(botwidth) [expr {50 * $charspc}] - set geometry(pwsash0) "[expr {40 * $charspc}] 2" - set geometry(pwsash1) "[expr {60 * $charspc}] 2" + 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 - frame .tf -height $geometry(topheight) -width $geometry(topwidth) - frame .tf.histframe - panedwindow .tf.histframe.pwclist -orient horizontal -sashpad 0 -handlesize 4 + ${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 @@ -1777,28 +2127,37 @@ proc makewindow {} { -selectbackground $selectbgcolor \ -background $bgcolor -bd 0 -yscrollincr $linespc .tf.histframe.pwclist add $canv3 - eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0) - eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1) + 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) + } # a scroll bar to rule them - scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0 + ${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 - frame .tf.bar - frame .tf.lbar -height 15 + ${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 \ + 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 - entry $sha1entry -width 40 -font textfont -textvariable sha1string + ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string trace add variable sha1string write sha1change pack $sha1entry -side left -pady 2 @@ -1818,36 +2177,43 @@ proc makewindow {} { 0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c, 0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01}; } - button .tf.bar.leftbut -image bm-left -command goback \ + ${NS}::button .tf.bar.leftbut -image bm-left -command goback \ -state disabled -width 26 pack .tf.bar.leftbut -side left -fill y - button .tf.bar.rightbut -image bm-right -command goforw \ + ${NS}::button .tf.bar.rightbut -image bm-right -command goforw \ -state disabled -width 26 pack .tf.bar.rightbut -side left -fill y - label .tf.bar.rowlabel -text [mc "Row"] + ${NS}::label .tf.bar.rowlabel -text [mc "Row"] set rownumsel {} - label .tf.bar.rownum -width 7 -font textfont -textvariable rownumsel \ + ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \ -relief sunken -anchor e - label .tf.bar.rowlabel2 -text "/" - label .tf.bar.numcommits -width 7 -font textfont -textvariable numcommits \ + ${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 - label $statusw -width 15 -relief sunken + ${NS}::label $statusw -width 15 -relief sunken pack $statusw -side left -padx 5 - set h [expr {[font metrics uifont -linespace] + 2}] - set progresscanv .tf.bar.progress - canvas $progresscanv -relief sunken -height $h -borderwidth 2 - set progressitem [$progresscanv create rect -1 0 0 $h -fill green] - set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow] - set rprogitem [$progresscanv create rect -1 0 0 $h -fill red] - pack $progresscanv -side right -expand 1 -fill x + 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 green] + set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow] + set rprogitem [$progresscanv create rect -1 0 0 $h -fill red] + } + pack $progresscanv -side right -expand 1 -fill x -padx {0 2} set progresscoords {0 0} set fprogcoord 0 set rprogcoord 0 @@ -1856,14 +2222,14 @@ proc makewindow {} { set progupdatepending 0 # build up the bottom bar of upper window - label .tf.lbar.flabel -text "[mc "Find"] " - button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1} - button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1} - label .tf.lbar.flab2 -text " [mc "commit"] " + ${NS}::label .tf.lbar.flabel -text "[mc "Find"] " + ${NS}::button .tf.lbar.fnext -text [mc "next"] -command {dofind 1 1} + ${NS}::button .tf.lbar.fprev -text [mc "prev"] -command {dofind -1 1} + ${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 [tk_optionMenu .tf.lbar.gdttype gdttype \ + set gm [makedroplist .tf.lbar.gdttype gdttype \ [mc "containing:"] \ [mc "touching paths:"] \ [mc "adding/removing string:"]] @@ -1873,14 +2239,14 @@ proc makewindow {} { set findstring {} set fstring .tf.lbar.findstring lappend entries $fstring - entry $fstring -width 30 -font textfont -textvariable findstring + ${NS}::entry $fstring -width 30 -textvariable findstring trace add variable findstring write find_change set findtype [mc "Exact"] - set findtypemenu [tk_optionMenu .tf.lbar.findtype \ - findtype [mc "Exact"] [mc "IgnCase"] [mc "Regexp"]] + 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"] - tk_optionMenu .tf.lbar.findloc findloc [mc "All fields"] [mc "Headline"] \ + 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 @@ -1892,50 +2258,62 @@ proc makewindow {} { pack .tf.bar -in .tf -side bottom -fill x pack .tf.histframe -fill both -side top -expand 1 .ctop add .tf - .ctop paneconfigure .tf -height $geometry(topheight) - .ctop paneconfigure .tf -width $geometry(topwidth) + if {!$use_ttk} { + .ctop paneconfigure .tf -height $geometry(topheight) + .ctop paneconfigure .tf -width $geometry(topwidth) + } # now build up the bottom - panedwindow .pwbottom -orient horizontal + ${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)]} { - frame .bleft -width $geometry(botwidth) + ${NS}::frame .bleft -width $geometry(botwidth) } else { - frame .bleft -width $geometry(botwidth) -height $geometry(botheight) + ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight) } - frame .bleft.top - frame .bleft.mid - frame .bleft.bottom + ${NS}::frame .bleft.top + ${NS}::frame .bleft.mid + ${NS}::frame .bleft.bottom - button .bleft.top.search -text [mc "Search"] -command dosearch + ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch pack .bleft.top.search -side left -padx 5 set sstring .bleft.top.sstring - entry $sstring -width 20 -font textfont -textvariable searchstring + 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 - radiobutton .bleft.mid.diff -text [mc "Diff"] \ + ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \ -command changediffdisp -variable diffelide -value {0 0} - radiobutton .bleft.mid.old -text [mc "Old version"] \ + ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \ -command changediffdisp -variable diffelide -value {0 1} - radiobutton .bleft.mid.new -text [mc "New version"] \ + ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \ -command changediffdisp -variable diffelide -value {1 0} - label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: " + ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: " pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left - spinbox .bleft.mid.diffcontext -width 5 -font textfont \ - -from 1 -increment 1 -to 10000000 \ + 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 - checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \ + ${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 -font textfont \ @@ -1944,9 +2322,8 @@ proc makewindow {} { if {$have_tk85} { $ctext conf -tabstyle wordprocessor } - scrollbar .bleft.bottom.sb -command "$ctext yview" - scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h \ - -width 10 + ${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 @@ -1962,7 +2339,7 @@ proc makewindow {} { $ctext tag conf filesep -font textfontbold -back "#aaaaaa" $ctext tag conf hunksep -fore [lindex $diffcolors 2] $ctext tag conf d0 -fore [lindex $diffcolors 0] - $ctext tag conf d1 -fore [lindex $diffcolors 1] + $ctext tag conf dresult -fore [lindex $diffcolors 1] $ctext tag conf m0 -fore red $ctext tag conf m1 -fore blue $ctext tag conf m2 -fore green @@ -1986,14 +2363,16 @@ proc makewindow {} { $ctext tag conf found -back yellow .pwbottom add .bleft - .pwbottom paneconfigure .bleft -width $geometry(botwidth) + if {!$use_ttk} { + .pwbottom paneconfigure .bleft -width $geometry(botwidth) + } # lower right - frame .bright - frame .bright.mode - radiobutton .bright.mode.patch -text [mc "Patch"] \ + ${NS}::frame .bright + ${NS}::frame .bright.mode + ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \ -command reselectline -variable cmitmode -value "patch" - radiobutton .bright.mode.tree -text [mc "Tree"] \ + ${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 @@ -2009,7 +2388,7 @@ proc makewindow {} { -spacing1 1 -spacing3 1 lappend bglist $cflist lappend fglist $cflist - scrollbar .bright.sb -command "$cflist yview" + ${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 \ @@ -2032,10 +2411,27 @@ proc makewindow {} { } } + 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} @@ -2053,10 +2449,16 @@ proc makewindow {} { set delta [expr {- (%D)}] allcanvs yview scroll $delta units } + bindall <Shift-MouseWheel> { + set delta [expr {- (%D)}] + $canv xview scroll $delta units + } } } - bindall <2> "canvscan mark %W %x %y" - bindall <B2-Motion> "canvscan dragto %W %x %y" + 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" @@ -2080,18 +2482,24 @@ proc makewindow {} { bindkey n "selnextline 1" bindkey z "goback" bindkey x "goforw" - bindkey i "selnextline -1" - bindkey k "selnextline 1" - bindkey j "goback" + 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 / {dofind 1 1} + bindkey / {focus $fstring} + bindkey <Key-KP_Divide> {focus $fstring} bindkey <Key-Return> {dofind 1 1} bindkey ? {dofind -1 1} bindkey f nextfile - bindkey <F5> updatecommits + bind . <F5> updatecommits + bind . <$M1B-F5> reloadcommits + bind . <F2> showrefs + bind . <Shift-F4> {newview 0} + catch { bind . <Shift-Key-XF86_Switch_VT_4> {newview 0} } + bind . <F4> edit_or_newview bind . <$M1B-q> doquit bind . <$M1B-f> {dofind 1 1} bind . <$M1B-g> {dofind 1 0} @@ -2103,61 +2511,76 @@ proc makewindow {} { 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 + bind $sha1entry <Key-Return> {gotocommit; break} bind $sha1entry <<PasteSelection>> 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} - bind $cflist <Button-3> {pop_flist_menu %W %X %Y %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} set maincursor [. cget -cursor] set textcursor [$ctext cget -cursor] set curtextcursor $textcursor set rowctxmenu .rowctxmenu - menu $rowctxmenu -tearoff 0 - $rowctxmenu add command -label [mc "Diff this -> selected"] \ - -command {diffvssel 0} - $rowctxmenu add command -label [mc "Diff selected -> this"] \ - -command {diffvssel 1} - $rowctxmenu add command -label [mc "Make patch"] -command mkpatch - $rowctxmenu add command -label [mc "Create tag"] -command mktag - $rowctxmenu add command -label [mc "Write commit to file"] -command writecommit - $rowctxmenu add command -label [mc "Create new branch"] -command mkbranch - $rowctxmenu add command -label [mc "Cherry-pick this commit"] \ - -command cherrypick - $rowctxmenu add command -label [mc "Reset HEAD branch to here"] \ - -command resethead + 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 "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}} + } + $rowctxmenu configure -tearoff 0 set fakerowmenu .fakerowmenu - menu $fakerowmenu -tearoff 0 - $fakerowmenu add command -label [mc "Diff this -> selected"] \ - -command {diffvssel 0} - $fakerowmenu add command -label [mc "Diff selected -> this"] \ - -command {diffvssel 1} - $fakerowmenu add command -label [mc "Make patch"] -command mkpatch -# $fakerowmenu add command -label [mc "Commit"] -command {mkcommit 0} -# $fakerowmenu add command -label [mc "Commit all"] -command {mkcommit 1} -# $fakerowmenu add command -label [mc "Revert local changes"] -command revertlocal + 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 - menu $headctxmenu -tearoff 0 - $headctxmenu add command -label [mc "Check out this branch"] \ - -command cobranch - $headctxmenu add command -label [mc "Remove this branch"] \ - -command rmbranch + makemenu $headctxmenu { + {mc "Check out this branch" command cobranch} + {mc "Remove this branch" command rmbranch} + } + $headctxmenu configure -tearoff 0 global flist_menu set flist_menu .flistctxmenu - menu $flist_menu -tearoff 0 - $flist_menu add command -label [mc "Highlight this too"] \ - -command {flist_hl 0} - $flist_menu add command -label [mc "Highlight this only"] \ - -command {flist_hl 1} - $flist_menu add command -label [mc "External diff"] \ - -command {external_diff} + 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}} + } + $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 @@ -2237,7 +2660,12 @@ proc click {w} { proc adjustprogress {} { global progresscanv progressitem progresscoords global fprogitem fprogcoord lastprogupdate progupdatepending - global rprogitem rprogcoord + global rprogitem rprogcoord use_ttk + + 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]}] @@ -2272,13 +2700,18 @@ proc savestuff {w} { global maxwidth showneartags showlocalchanges global viewname viewfiles viewargs viewargscmd viewperm nextviewnum global cmitmode wrapcomment datetimeformat limitdiffs - global colors bgcolor fgcolor diffcolors diffcontext selectbgcolor - global autoselect extdifftool + global colors uicolor bgcolor fgcolor diffcolors diffcontext selectbgcolor + global autoselect autosellen extdifftool perfile_attrs markbgcolor use_ttk + global hideremotes want_ttk if {$stuffsaved} return if {![winfo viewable .]} return catch { + if {[file exists ~/.gitk-new]} {file delete -force ~/.gitk-new} set f [open "~/.gitk-new" w] + if {$::tcl_platform(platform) eq {windows}} { + file attributes "~/.gitk-new" -hidden true + } puts $f [list set mainfont $mainfont] puts $f [list set textfont $textfont] puts $f [list set uifont $uifont] @@ -2289,23 +2722,35 @@ proc savestuff {w} { puts $f [list set cmitmode $cmitmode] puts $f [list set wrapcomment $wrapcomment] puts $f [list set autoselect $autoselect] + puts $f [list set autosellen $autosellen] puts $f [list set showneartags $showneartags] + puts $f [list set hideremotes $hideremotes] puts $f [list set showlocalchanges $showlocalchanges] puts $f [list set datetimeformat $datetimeformat] puts $f [list set limitdiffs $limitdiffs] + puts $f [list set uicolor $uicolor] + puts $f [list set want_ttk $want_ttk] puts $f [list set bgcolor $bgcolor] puts $f [list set fgcolor $fgcolor] puts $f [list set colors $colors] puts $f [list set diffcolors $diffcolors] + puts $f [list set markbgcolor $markbgcolor] puts $f [list set diffcontext $diffcontext] puts $f [list set selectbgcolor $selectbgcolor] puts $f [list set extdifftool $extdifftool] + puts $f [list set perfile_attrs $perfile_attrs] 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]" - puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sash coord 0]\"" - puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sash coord 1]\"" + if {$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]" @@ -2323,10 +2768,15 @@ proc savestuff {w} { } proc resizeclistpanes {win w} { - global oldwidth + global oldwidth use_ttk if {[info exists oldwidth($win)]} { - set s0 [$win sash coord 0] - set s1 [$win sash coord 1] + 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)}] @@ -2347,16 +2797,25 @@ proc resizeclistpanes {win w} { } } } - $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 } proc resizecdetpanes {win w} { - global oldwidth + global oldwidth use_ttk if {[info exists oldwidth($win)]} { - set s0 [$win sash coord 0] + 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 { @@ -2369,7 +2828,11 @@ proc resizecdetpanes {win w} { set sash0 [expr {$w - 15}] } } - $win sash place 0 $sash0 [lindex $s0 1] + if {$use_ttk} { + $win sashpos 0 $sash0 + } else { + $win sash place 0 $sash0 [lindex $s0 1] + } } set oldwidth($win) $w } @@ -2389,30 +2852,33 @@ proc bindall {event action} { } proc about {} { - global uifont + global uifont NS set w .about if {[winfo exists $w]} { raise $w return } - toplevel $w + ttk_toplevel $w wm title $w [mc "About gitk"] + make_transient $w . message $w.m -text [mc " Gitk - a commit viewer for git -Copyright © 2005-2008 Paul Mackerras +Copyright \u00a9 2005-2011 Paul Mackerras Use and redistribute under the terms of the GNU General Public License"] \ -justify center -aspect 400 -border 2 -bg white -relief groove pack $w.m -side top -fill x -padx 2 -pady 2 - button $w.ok -text [mc "Close"] -command "destroy $w" -default active + ${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 NS set w .keys if {[winfo exists $w]} { raise $w @@ -2423,17 +2889,19 @@ proc keys {} { } else { set M1T Ctrl } - toplevel $w + 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, i Move up one commit"] -[mc "<Down>, n, k Move down one commit"] -[mc "<Left>, z, j Go back in history list"] +[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 "<PageUp> Move up one page in commit list"] [mc "<PageDown> Move down one page in commit list"] @@ -2453,7 +2921,7 @@ proc keys {} { [mc "<%s-F> Find" $M1T] [mc "<%s-G> Move to next find hit" $M1T] [mc "<Return> Move to next find hit"] -[mc "/ Move to next find hit, or redo find"] +[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] @@ -2466,7 +2934,8 @@ proc keys {} { " \ -justify left -bg white -border 2 -relief groove pack $w.m -side top -fill both -padx 2 -pady 2 - button $w.ok -text [mc "Close"] -command "destroy $w" -default active + ${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" @@ -2647,7 +3116,7 @@ proc treeopendir {w dir} { $w insert e:$ix $e [highlight_tag $de] } } - $w mark gravity e:$ix left + $w mark gravity e:$ix right $w conf -state disabled set treediropen($dir) 1 set top [lindex [split [$w index @0,0] .] 0] @@ -2688,9 +3157,15 @@ proc treeclick {w x y} { } proc setfilelist {id} { - global treefilelist cflist + 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 + } + } } image create bitmap tri-rt -background black -foreground blue -data { @@ -2859,6 +3334,38 @@ proc pop_flist_menu {w X Y x y} { tk_popup $flist_menu $X $Y } +proc find_ctext_fileinfo {line} { + global ctext_file_names ctext_file_lines + + set ok [bsearch $ctext_file_lines $line] + set tline [lindex $ctext_file_lines $ok] + + if {$ok >= [llength $ctext_file_lines] || $line < $tline} { + return {} + } else { + return [list [lindex $ctext_file_names $ok] $tline] + } +} + +proc pop_diff_menu {w X Y x y} { + global ctext diff_menu flist_menu_file + global diff_menu_txtpos diff_menu_line + global diff_menu_filebase + + set diff_menu_txtpos [split [$w index "@$x,$y"] "."] + set diff_menu_line [lindex $diff_menu_txtpos 0] + # don't pop up the menu on hunk-separator or file-separator lines + if {[lsearch -glob [$ctext tag names $diff_menu_line.0] "*sep"] >= 0} { + return + } + stopfinding + set f [find_ctext_fileinfo $diff_menu_line] + if {$f eq {}} return + set flist_menu_file [lindex $f 0] + set diff_menu_filebase [lindex $f 1] + tk_popup $diff_menu $X $Y +} + proc flist_hl {only} { global flist_menu_file findstring gdttype @@ -2871,6 +3378,27 @@ proc flist_hl {only} { set gdttype [mc "touching paths:"] } +proc gitknewtmpdir {} { + global diffnum gitktmpdir gitdir + + if {![info exists gitktmpdir]} { + set gitktmpdir [file join $gitdir [format ".gitk-tmp.%s" [pid]]] + if {[catch {file mkdir $gitktmpdir} err]} { + error_popup "[mc "Error creating temporary directory %s:" $gitktmpdir] $err" + unset gitktmpdir + return {} + } + set diffnum 0 + } + incr diffnum + set diffdir [file join $gitktmpdir $diffnum] + if {[catch {file mkdir $diffdir} err]} { + error_popup "[mc "Error creating temporary directory %s:" $diffdir] $err" + return {} + } + return $diffdir +} + proc save_file_from_commit {filename output what} { global nullfile @@ -2878,7 +3406,7 @@ proc save_file_from_commit {filename output what} { if {[string match "fatal: bad revision *" $err]} { return $nullfile } - error_popup "Error getting \"$filename\" from $what: $err" + error_popup "[mc "Error getting \"%s\" from %s:" $filename $what] $err" return {} } return $output @@ -2886,10 +3414,10 @@ proc save_file_from_commit {filename output what} { proc external_diff_get_one_file {diffid filename diffdir} { global nullid nullid2 nullfile - global gitdir + global worktree if {$diffid == $nullid} { - set difffile [file join [file dirname $gitdir] $filename] + set difffile [file join $worktree $filename] if {[file exists $difffile]} { return $difffile } @@ -2905,11 +3433,10 @@ proc external_diff_get_one_file {diffid filename diffdir} { } proc external_diff {} { - global gitktmpdir nullid nullid2 + global nullid nullid2 global flist_menu_file global diffids - global diffnum - global gitdir extdifftool + global extdifftool if {[llength $diffids] == 1} { # no reference commit given @@ -2931,33 +3458,18 @@ proc external_diff {} { } # make sure that several diffs wont collide - if {![info exists gitktmpdir]} { - set gitktmpdir [file join [file dirname $gitdir] \ - [format ".gitk-tmp.%s" [pid]]] - if {[catch {file mkdir $gitktmpdir} err]} { - error_popup "Error creating temporary directory $gitktmpdir: $err" - unset gitktmpdir - return - } - set diffnum 0 - } - incr diffnum - set diffdir [file join $gitktmpdir $diffnum] - if {[catch {file mkdir $diffdir} err]} { - error_popup "Error creating temporary directory $diffdir: $err" - return - } + set diffdir [gitknewtmpdir] + if {$diffdir eq {}} return # gather files to diff set difffromfile [external_diff_get_one_file $diffidfrom $flist_menu_file $diffdir] set difftofile [external_diff_get_one_file $diffidto $flist_menu_file $diffdir] if {$difffromfile ne {} && $difftofile ne {}} { - set cmd [concat | [shellsplit $extdifftool] \ - [list $difffromfile $difftofile]] - if {[catch {set fl [open $cmd r]} err]} { + set cmd [list [shellsplit $extdifftool] $difffromfile $difftofile] + if {[catch {set fl [open |$cmd r]} err]} { file delete -force $diffdir - error_popup [mc "$extdifftool: command failed: $err"] + error_popup "$extdifftool: [mc "command failed:"] $err" } else { fconfigure $fl -blocking 0 filerun $fl [list delete_at_eof $fl $diffdir] @@ -2965,12 +3477,303 @@ proc external_diff {} { } } +proc find_hunk_blamespec {base line} { + global ctext + + # Find and parse the hunk header + set s_lix [$ctext search -backwards -regexp ^@@ "$line.0 lineend" $base.0] + if {$s_lix eq {}} return + + set s_line [$ctext get $s_lix "$s_lix + 1 lines"] + if {![regexp {^@@@*(( -\d+(,\d+)?)+) \+(\d+)(,\d+)? @@} $s_line \ + s_line old_specs osz osz1 new_line nsz]} { + return + } + + # base lines for the parents + set base_lines [list $new_line] + foreach old_spec [lrange [split $old_specs " "] 1 end] { + if {![regexp -- {-(\d+)(,\d+)?} $old_spec \ + old_spec old_line osz]} { + return + } + lappend base_lines $old_line + } + + # Now scan the lines to determine offset within the hunk + set max_parent [expr {[llength $base_lines]-2}] + set dline 0 + set s_lno [lindex [split $s_lix "."] 0] + + # Determine if the line is removed + set chunk [$ctext get $line.0 "$line.1 + $max_parent chars"] + if {[string match {[-+ ]*} $chunk]} { + set removed_idx [string first "-" $chunk] + # Choose a parent index + if {$removed_idx >= 0} { + set parent $removed_idx + } else { + set unchanged_idx [string first " " $chunk] + if {$unchanged_idx >= 0} { + set parent $unchanged_idx + } else { + # blame the current commit + set parent -1 + } + } + # then count other lines that belong to it + for {set i $line} {[incr i -1] > $s_lno} {} { + set chunk [$ctext get $i.0 "$i.1 + $max_parent chars"] + # Determine if the line is removed + set removed_idx [string first "-" $chunk] + if {$parent >= 0} { + set code [string index $chunk $parent] + if {$code eq "-" || ($removed_idx < 0 && $code ne "+")} { + incr dline + } + } else { + if {$removed_idx < 0} { + incr dline + } + } + } + incr parent + } else { + set parent 0 + } + + incr dline [lindex $base_lines $parent] + return [list $parent $dline] +} + +proc external_blame_diff {} { + global currentid cmitmode + global diff_menu_txtpos diff_menu_line + global diff_menu_filebase flist_menu_file + + if {$cmitmode eq "tree"} { + set parent_idx 0 + set line [expr {$diff_menu_line - $diff_menu_filebase}] + } else { + set hinfo [find_hunk_blamespec $diff_menu_filebase $diff_menu_line] + if {$hinfo ne {}} { + set parent_idx [lindex $hinfo 0] + set line [lindex $hinfo 1] + } else { + set parent_idx 0 + set line 0 + } + } + + external_blame $parent_idx $line +} + +# Find the SHA1 ID of the blob for file $fname in the index +# at stage 0 or 2 +proc index_sha1 {fname} { + set f [open [list | git ls-files -s $fname] r] + while {[gets $f line] >= 0} { + set info [lindex [split $line "\t"] 0] + set stage [lindex $info 2] + if {$stage eq "0" || $stage eq "2"} { + close $f + return [lindex $info 1] + } + } + close $f + return {} +} + +# Turn an absolute path into one relative to the current directory +proc make_relative {f} { + if {[file pathtype $f] eq "relative"} { + return $f + } + set elts [file split $f] + set here [file split [pwd]] + set ei 0 + set hi 0 + set res {} + foreach d $here { + if {$ei < $hi || $ei >= [llength $elts] || [lindex $elts $ei] ne $d} { + lappend res ".." + } else { + incr ei + } + incr hi + } + set elts [concat $res [lrange $elts $ei end]] + return [eval file join $elts] +} + +proc external_blame {parent_idx {line {}}} { + global flist_menu_file cdup + global nullid nullid2 + global parentlist selectedline currentid + + if {$parent_idx > 0} { + set base_commit [lindex $parentlist $selectedline [expr {$parent_idx-1}]] + } else { + set base_commit $currentid + } + + if {$base_commit eq {} || $base_commit eq $nullid || $base_commit eq $nullid2} { + error_popup [mc "No such commit"] + return + } + + set cmdline [list git gui blame] + if {$line ne {} && $line > 1} { + lappend cmdline "--line=$line" + } + set f [file join $cdup $flist_menu_file] + # Unfortunately it seems git gui blame doesn't like + # being given an absolute path... + set f [make_relative $f] + lappend cmdline $base_commit $f + if {[catch {eval exec $cmdline &} err]} { + error_popup "[mc "git gui blame: command failed:"] $err" + } +} + +proc show_line_source {} { + global cmitmode currentid parents curview blamestuff blameinst + global diff_menu_line diff_menu_filebase flist_menu_file + global nullid nullid2 gitdir cdup + + set from_index {} + if {$cmitmode eq "tree"} { + set id $currentid + set line [expr {$diff_menu_line - $diff_menu_filebase}] + } else { + set h [find_hunk_blamespec $diff_menu_filebase $diff_menu_line] + if {$h eq {}} return + set pi [lindex $h 0] + if {$pi == 0} { + mark_ctext_line $diff_menu_line + return + } + incr pi -1 + if {$currentid eq $nullid} { + if {$pi > 0} { + # must be a merge in progress... + if {[catch { + # get the last line from .git/MERGE_HEAD + set f [open [file join $gitdir MERGE_HEAD] r] + set id [lindex [split [read $f] "\n"] end-1] + close $f + } err]} { + error_popup [mc "Couldn't read merge head: %s" $err] + return + } + } elseif {$parents($curview,$currentid) eq $nullid2} { + # need to do the blame from the index + if {[catch { + set from_index [index_sha1 $flist_menu_file] + } err]} { + error_popup [mc "Error reading index: %s" $err] + return + } + } else { + set id $parents($curview,$currentid) + } + } else { + set id [lindex $parents($curview,$currentid) $pi] + } + set line [lindex $h 1] + } + set blameargs {} + if {$from_index ne {}} { + lappend blameargs | git cat-file blob $from_index + } + lappend blameargs | git blame -p -L$line,+1 + if {$from_index ne {}} { + lappend blameargs --contents - + } else { + lappend blameargs $id + } + lappend blameargs -- [file join $cdup $flist_menu_file] + if {[catch { + set f [open $blameargs r] + } err]} { + error_popup [mc "Couldn't start git blame: %s" $err] + return + } + nowbusy blaming [mc "Searching"] + fconfigure $f -blocking 0 + set i [reg_instance $f] + set blamestuff($i) {} + set blameinst $i + filerun $f [list read_line_source $f $i] +} + +proc stopblaming {} { + global blameinst + + if {[info exists blameinst]} { + stop_instance $blameinst + unset blameinst + notbusy blaming + } +} + +proc read_line_source {fd inst} { + global blamestuff curview commfd blameinst nullid nullid2 + + while {[gets $fd line] >= 0} { + lappend blamestuff($inst) $line + } + if {![eof $fd]} { + return 1 + } + unset commfd($inst) + unset blameinst + notbusy blaming + fconfigure $fd -blocking 1 + if {[catch {close $fd} err]} { + error_popup [mc "Error running git blame: %s" $err] + return 0 + } + + set fname {} + set line [split [lindex $blamestuff($inst) 0] " "] + set id [lindex $line 0] + set lnum [lindex $line 1] + if {[string length $id] == 40 && [string is xdigit $id] && + [string is digit -strict $lnum]} { + # look for "filename" line + foreach l $blamestuff($inst) { + if {[string match "filename *" $l]} { + set fname [string range $l 9 end] + break + } + } + } + if {$fname ne {}} { + # all looks good, select it + if {$id eq $nullid} { + # blame uses all-zeroes to mean not committed, + # which would mean a change in the index + set id $nullid2 + } + if {[commitinview $id $curview]} { + selectline [rowofcommit $id] 1 [list $fname $lnum] + } else { + error_popup [mc "That line comes from commit %s, \ + which is not in this view" [shortids $id]] + } + } else { + puts "oops couldn't parse git blame output" + } + return 0 +} + # delete $dir when we see eof on $f (presumably because the child has exited) proc delete_at_eof {f dir} { while {[gets $f line] >= 0} {} if {[eof $f]} { if {[catch {close $f} err]} { - error_popup "External diff viewer failed: $err" + error_popup "[mc "External diff viewer failed:"] $err" } file delete -force $dir return 0 @@ -3075,8 +3878,8 @@ proc shellsplit {str} { # Code to implement multiple views proc newview {ishighlight} { - global nextviewnum newviewname newviewperm newishighlight - global newviewargs revtreeargs viewargscmd newviewargscmd curview + global nextviewnum newviewname newishighlight + global revtreeargs viewargscmd newviewopts curview set newishighlight $ishighlight set top .gitkview @@ -3084,75 +3887,265 @@ proc newview {ishighlight} { raise $top return } + decode_view_opts $nextviewnum $revtreeargs set newviewname($nextviewnum) "[mc "View"] $nextviewnum" - set newviewperm($nextviewnum) 0 - set newviewargs($nextviewnum) [shellarglist $revtreeargs] - set newviewargscmd($nextviewnum) $viewargscmd($curview) + set newviewopts($nextviewnum,perm) 0 + set newviewopts($nextviewnum,cmd) $viewargscmd($curview) vieweditor $top $nextviewnum [mc "Gitk view definition"] } +set known_view_options { + {perm b . {} {mc "Remember this view"}} + {reflabel l + {} {mc "References (space separated list):"}} + {refs t15 .. {} {mc "Branches & tags:"}} + {allrefs b *. "--all" {mc "All refs"}} + {branches b . "--branches" {mc "All (local) branches"}} + {tags b . "--tags" {mc "All tags"}} + {remotes b . "--remotes" {mc "All remote-tracking branches"}} + {commitlbl l + {} {mc "Commit Info (regular expressions):"}} + {author t15 .. "--author=*" {mc "Author:"}} + {committer t15 . "--committer=*" {mc "Committer:"}} + {loginfo t15 .. "--grep=*" {mc "Commit Message:"}} + {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}} + {changes_l l + {} {mc "Changes to Files:"}} + {pickaxe_s r0 . {} {mc "Fixed String"}} + {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}} + {pickaxe t15 .. "-S*" {mc "Search string:"}} + {datelabel l + {} {mc "Commit Dates (\"2 weeks ago\", \"2009-03-17 15:27:38\", \"March 17, 2009 15:27:38\"):"}} + {since t15 .. {"--since=*" "--after=*"} {mc "Since:"}} + {until t15 . {"--until=*" "--before=*"} {mc "Until:"}} + {limit_lbl l + {} {mc "Limit and/or skip a number of revisions (positive integer):"}} + {limit t10 *. "--max-count=*" {mc "Number to show:"}} + {skip t10 . "--skip=*" {mc "Number to skip:"}} + {misc_lbl l + {} {mc "Miscellaneous options:"}} + {dorder b *. {"--date-order" "-d"} {mc "Strictly sort by date"}} + {lright b . "--left-right" {mc "Mark branch sides"}} + {first b . "--first-parent" {mc "Limit to first parent"}} + {smplhst b . "--simplify-by-decoration" {mc "Simple history"}} + {args t50 *. {} {mc "Additional arguments to git log:"}} + {allpaths path + {} {mc "Enter files and directories to include, one per line:"}} + {cmd t50= + {} {mc "Command to generate more commits to include:"}} + } + +# Convert $newviewopts($n, ...) into args for git log. +proc encode_view_opts {n} { + global known_view_options newviewopts + + set rargs [list] + foreach opt $known_view_options { + set patterns [lindex $opt 3] + if {$patterns eq {}} continue + set pattern [lindex $patterns 0] + + if {[lindex $opt 1] eq "b"} { + set val $newviewopts($n,[lindex $opt 0]) + if {$val} { + lappend rargs $pattern + } + } elseif {[regexp {^r(\d+)$} [lindex $opt 1] type value]} { + regexp {^(.*_)} [lindex $opt 0] uselessvar button_id + set val $newviewopts($n,$button_id) + if {$val eq $value} { + lappend rargs $pattern + } + } else { + set val $newviewopts($n,[lindex $opt 0]) + set val [string trim $val] + if {$val ne {}} { + set pfix [string range $pattern 0 end-1] + lappend rargs $pfix$val + } + } + } + set rargs [concat $rargs [shellsplit $newviewopts($n,refs)]] + return [concat $rargs [shellsplit $newviewopts($n,args)]] +} + +# Fill $newviewopts($n, ...) based on args for git log. +proc decode_view_opts {n view_args} { + global known_view_options newviewopts + + foreach opt $known_view_options { + set id [lindex $opt 0] + if {[lindex $opt 1] eq "b"} { + # Checkboxes + set val 0 + } elseif {[regexp {^r(\d+)$} [lindex $opt 1]]} { + # Radiobuttons + regexp {^(.*_)} $id uselessvar id + set val 0 + } else { + # Text fields + set val {} + } + set newviewopts($n,$id) $val + } + set oargs [list] + set refargs [list] + foreach arg $view_args { + if {[regexp -- {^-([0-9]+)$} $arg arg cnt] + && ![info exists found(limit)]} { + set newviewopts($n,limit) $cnt + set found(limit) 1 + continue + } + catch { unset val } + foreach opt $known_view_options { + set id [lindex $opt 0] + if {[info exists found($id)]} continue + foreach pattern [lindex $opt 3] { + if {![string match $pattern $arg]} continue + if {[lindex $opt 1] eq "b"} { + # Check buttons + set val 1 + } elseif {[regexp {^r(\d+)$} [lindex $opt 1] match num]} { + # Radio buttons + regexp {^(.*_)} $id uselessvar id + set val $num + } else { + # Text input fields + set size [string length $pattern] + set val [string range $arg [expr {$size-1}] end] + } + set newviewopts($n,$id) $val + set found($id) 1 + break + } + if {[info exists val]} break + } + if {[info exists val]} continue + if {[regexp {^-} $arg]} { + lappend oargs $arg + } else { + lappend refargs $arg + } + } + set newviewopts($n,refs) [shellarglist $refargs] + set newviewopts($n,args) [shellarglist $oargs] +} + +proc edit_or_newview {} { + global curview + + if {$curview > 0} { + editview + } else { + newview 0 + } +} + proc editview {} { global curview - global viewname viewperm newviewname newviewperm - global viewargs newviewargs viewargscmd newviewargscmd + global viewname viewperm newviewname newviewopts + global viewargs viewargscmd set top .gitkvedit-$curview if {[winfo exists $top]} { raise $top return } - set newviewname($curview) $viewname($curview) - set newviewperm($curview) $viewperm($curview) - set newviewargs($curview) [shellarglist $viewargs($curview)] - set newviewargscmd($curview) $viewargscmd($curview) - vieweditor $top $curview "Gitk: edit view $viewname($curview)" + decode_view_opts $curview $viewargs($curview) + set newviewname($curview) $viewname($curview) + set newviewopts($curview,perm) $viewperm($curview) + set newviewopts($curview,cmd) $viewargscmd($curview) + vieweditor $top $curview "[mc "Gitk: edit view"] $viewname($curview)" } proc vieweditor {top n title} { - global newviewname newviewperm viewfiles bgcolor - - toplevel $top - wm title $top $title - label $top.nl -text [mc "Name"] - entry $top.name -width 20 -textvariable newviewname($n) - grid $top.nl $top.name -sticky w -pady 5 - checkbutton $top.perm -text [mc "Remember this view"] \ - -variable newviewperm($n) - grid $top.perm - -pady 5 -sticky w - message $top.al -aspect 1000 \ - -text [mc "Commits to include (arguments to git log):"] - grid $top.al - -sticky w -pady 5 - entry $top.args -width 50 -textvariable newviewargs($n) \ - -background $bgcolor - grid $top.args - -sticky ew -padx 5 - - message $top.ac -aspect 1000 \ - -text [mc "Command to generate more commits to include:"] - grid $top.ac - -sticky w -pady 5 - entry $top.argscmd -width 50 -textvariable newviewargscmd($n) \ - -background white - grid $top.argscmd - -sticky ew -padx 5 - - message $top.l -aspect 1000 \ - -text [mc "Enter files and directories to include, one per line:"] - grid $top.l - -sticky w - text $top.t -width 40 -height 10 -background $bgcolor -font uifont - if {[info exists viewfiles($n)]} { - foreach f $viewfiles($n) { - $top.t insert end $f - $top.t insert end "\n" - } - $top.t delete {end - 1c} end - $top.t mark set insert 0.0 - } - grid $top.t - -sticky ew -padx 5 - frame $top.buts - button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n] - button $top.buts.can -text [mc "Cancel"] -command [list destroy $top] - grid $top.buts.ok $top.buts.can + global newviewname newviewopts viewfiles bgcolor + global known_view_options NS + + ttk_toplevel $top + wm title $top [concat $title [mc "-- criteria for selecting revisions"]] + make_transient $top . + + # View name + ${NS}::frame $top.nfr + ${NS}::label $top.nl -text [mc "View Name"] + ${NS}::entry $top.name -width 20 -textvariable newviewname($n) + pack $top.nfr -in $top -fill x -pady 5 -padx 3 + pack $top.nl -in $top.nfr -side left -padx {0 5} + pack $top.name -in $top.nfr -side left -padx {0 25} + + # View options + set cframe $top.nfr + set cexpand 0 + set cnt 0 + foreach opt $known_view_options { + set id [lindex $opt 0] + set type [lindex $opt 1] + set flags [lindex $opt 2] + set title [eval [lindex $opt 4]] + set lxpad 0 + + if {$flags eq "+" || $flags eq "*"} { + set cframe $top.fr$cnt + incr cnt + ${NS}::frame $cframe + pack $cframe -in $top -fill x -pady 3 -padx 3 + set cexpand [expr {$flags eq "*"}] + } elseif {$flags eq ".." || $flags eq "*."} { + set cframe $top.fr$cnt + incr cnt + ${NS}::frame $cframe + pack $cframe -in $top -fill x -pady 3 -padx [list 15 3] + set cexpand [expr {$flags eq "*."}] + } else { + set lxpad 5 + } + + if {$type eq "l"} { + ${NS}::label $cframe.l_$id -text $title + pack $cframe.l_$id -in $cframe -side left -pady [list 3 0] -anchor w + } elseif {$type eq "b"} { + ${NS}::checkbutton $cframe.c_$id -text $title -variable newviewopts($n,$id) + pack $cframe.c_$id -in $cframe -side left \ + -padx [list $lxpad 0] -expand $cexpand -anchor w + } elseif {[regexp {^r(\d+)$} $type type sz]} { + regexp {^(.*_)} $id uselessvar button_id + ${NS}::radiobutton $cframe.c_$id -text $title -variable newviewopts($n,$button_id) -value $sz + pack $cframe.c_$id -in $cframe -side left \ + -padx [list $lxpad 0] -expand $cexpand -anchor w + } elseif {[regexp {^t(\d+)$} $type type sz]} { + ${NS}::label $cframe.l_$id -text $title + ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \ + -textvariable newviewopts($n,$id) + pack $cframe.l_$id -in $cframe -side left -padx [list $lxpad 0] + pack $cframe.e_$id -in $cframe -side left -expand 1 -fill x + } elseif {[regexp {^t(\d+)=$} $type type sz]} { + ${NS}::label $cframe.l_$id -text $title + ${NS}::entry $cframe.e_$id -width $sz -background $bgcolor \ + -textvariable newviewopts($n,$id) + pack $cframe.l_$id -in $cframe -side top -pady [list 3 0] -anchor w + pack $cframe.e_$id -in $cframe -side top -fill x + } elseif {$type eq "path"} { + ${NS}::label $top.l -text $title + pack $top.l -in $top -side top -pady [list 3 0] -anchor w -padx 3 + text $top.t -width 40 -height 5 -background $bgcolor + if {[info exists viewfiles($n)]} { + foreach f $viewfiles($n) { + $top.t insert end $f + $top.t insert end "\n" + } + $top.t delete {end - 1c} end + $top.t mark set insert 0.0 + } + pack $top.t -in $top -side top -pady [list 0 5] -fill both -expand 1 -padx 3 + } + } + + ${NS}::frame $top.buts + ${NS}::button $top.buts.ok -text [mc "OK"] -command [list newviewok $top $n] + ${NS}::button $top.buts.apply -text [mc "Apply (F5)"] -command [list newviewok $top $n 1] + ${NS}::button $top.buts.can -text [mc "Cancel"] -command [list destroy $top] + bind $top <Control-Return> [list newviewok $top $n] + bind $top <F5> [list newviewok $top $n 1] + bind $top <Escape> [list destroy $top] + grid $top.buts.ok $top.buts.apply $top.buts.can grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a - grid $top.buts - -pady 10 -sticky ew + grid columnconfigure $top.buts 2 -weight 1 -uniform a + pack $top.buts -in $top -side top -fill x focus $top.t } @@ -3173,17 +4166,15 @@ proc allviewmenus {n op args} { # doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args } -proc newviewok {top n} { +proc newviewok {top n {apply 0}} { global nextviewnum newviewperm newviewname newishighlight global viewname viewfiles viewperm selectedview curview - global viewargs newviewargs viewargscmd newviewargscmd viewhlmenu + global viewargs viewargscmd newviewopts viewhlmenu if {[catch { - set newargs [shellsplit $newviewargs($n)] + set newargs [encode_view_opts $n] } err]} { - error_popup "[mc "Error in commit selection arguments:"] $err" - wm raise $top - focus $top + error_popup "[mc "Error in commit selection arguments:"] $err" $top return } set files {} @@ -3197,10 +4188,10 @@ proc newviewok {top n} { # creating a new view incr nextviewnum set viewname($n) $newviewname($n) - set viewperm($n) $newviewperm($n) + set viewperm($n) $newviewopts($n,perm) set viewfiles($n) $files set viewargs($n) $newargs - set viewargscmd($n) $newviewargscmd($n) + set viewargscmd($n) $newviewopts($n,cmd) addviewmenu $n if {!$newishighlight} { run showview $n @@ -3209,7 +4200,7 @@ proc newviewok {top n} { } } else { # editing an existing view - set viewperm($n) $newviewperm($n) + set viewperm($n) $newviewopts($n,perm) if {$newviewname($n) ne $viewname($n)} { set viewname($n) $newviewname($n) doviewmenu .bar.view 5 [list showview $n] \ @@ -3218,15 +4209,16 @@ proc newviewok {top n} { # entryconf [list -label $viewname($n) -value $viewname($n)] } if {$files ne $viewfiles($n) || $newargs ne $viewargs($n) || \ - $newviewargscmd($n) ne $viewargscmd($n)} { + $newviewopts($n,cmd) ne $viewargscmd($n)} { set viewfiles($n) $files set viewargs($n) $newargs - set viewargscmd($n) $newviewargscmd($n) + set viewargscmd($n) $newviewopts($n,cmd) if {$curview == $n} { run reloadcommits } } } + if {$apply} return catch {destroy $top} } @@ -3295,15 +4287,12 @@ proc showview {n} { set curview $n set selectedview $n - .bar.view entryconf [mc "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}] - .bar.view entryconf [mc "Delete view"] -state [expr {$n == 0? "disabled": "normal"}] + .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}] + .bar.view entryconf [mca "Delete view"] -state [expr {$n == 0? "disabled": "normal"}] run refill_reflist if {![info exists viewcomplete($n)]} { - if {$selid ne {}} { - set pending_select $selid - } - getcommits + getcommits $selid return } @@ -3337,18 +4326,18 @@ proc showview {n} { drawvisible if {$row ne {}} { selectline $row 0 - } elseif {$mainheadid ne {} && [commitinview $mainheadid $curview]} { - selectline [rowofcommit $mainheadid] 1 } elseif {!$viewcomplete($n)} { - if {$selid ne {}} { - set pending_select $selid - } else { - set pending_select $mainheadid - } + reset_pending_select $selid } else { - set row [first_real_row] - if {$row < $numcommits} { - selectline $row 0 + reset_pending_select {} + + if {[commitinview $pending_select $curview]} { + selectline [rowofcommit $pending_select] 1 + } else { + set row [first_real_row] + if {$row < $numcommits} { + selectline $row 0 + } } } if {!$viewcomplete($n)} { @@ -3380,28 +4369,34 @@ proc ishighlighted {id} { return 0 } -proc bolden {row font} { - global canv linehtag selectedline boldrows +proc bolden {id font} { + global canv linehtag currentid boldids need_redisplay markedid - lappend boldrows $row - $canv itemconf $linehtag($row) -font $font - if {$row == $selectedline} { + # need_redisplay = 1 means the display is stale and about to be redrawn + if {$need_redisplay} return + lappend boldids $id + $canv itemconf $linehtag($id) -font $font + if {[info exists currentid] && $id eq $currentid} { $canv delete secsel - set t [eval $canv create rect [$canv bbox $linehtag($row)] \ + set t [eval $canv create rect [$canv bbox $linehtag($id)] \ -outline {{}} -tags secsel \ -fill [$canv cget -selectbackground]] $canv lower $t } + if {[info exists markedid] && $id eq $markedid} { + make_idmark $id + } } -proc bolden_name {row font} { - global canv2 linentag selectedline boldnamerows +proc bolden_name {id font} { + global canv2 linentag currentid boldnameids need_redisplay - lappend boldnamerows $row - $canv2 itemconf $linentag($row) -font $font - if {$row == $selectedline} { + if {$need_redisplay} return + lappend boldnameids $id + $canv2 itemconf $linentag($id) -font $font + if {[info exists currentid] && $id eq $currentid} { $canv2 delete secsel - set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \ + set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] \ -outline {{}} -tags secsel \ -fill [$canv2 cget -selectbackground]] $canv2 lower $t @@ -3409,17 +4404,17 @@ proc bolden_name {row font} { } proc unbolden {} { - global boldrows + global boldids set stillbold {} - foreach row $boldrows { - if {![ishighlighted [commitonrow $row]]} { - bolden $row mainfont + foreach id $boldids { + if {![ishighlighted $id]} { + bolden $id mainfont } else { - lappend stillbold $row + lappend stillbold $id } } - set boldrows $stillbold + set boldids $stillbold } proc addvhighlight {n} { @@ -3460,7 +4455,7 @@ proc vhighlightmore {} { set row [rowofcommit $id] if {$r0 <= $row && $row <= $r1} { if {![highlighted $row]} { - bolden $row mainfontbold + bolden $id mainfontbold } set vhighlights($id) 1 } @@ -3475,7 +4470,7 @@ proc askvhighlight {row id} { if {[commitinview $id $hlview]} { if {[info exists iddrawn($id)] && ![ishighlighted $id]} { - bolden $row mainfontbold + bolden $id mainfontbold } set vhighlights($id) 1 } else { @@ -3485,7 +4480,7 @@ proc askvhighlight {row id} { proc hfiles_change {} { global highlight_files filehighlight fhighlights fh_serial - global highlight_paths gdttype + global highlight_paths if {[info exists filehighlight]} { # delete previous highlights @@ -3543,15 +4538,15 @@ proc find_change {name ix op} { } proc findcom_change args { - global nhighlights boldnamerows + global nhighlights boldnameids global findpattern findtype findstring gdttype stopfinding # delete previous highlights, if any - foreach row $boldnamerows { - bolden_name $row mainfont + foreach id $boldnameids { + bolden_name $id mainfont } - set boldnamerows {} + set boldnameids {} catch {unset nhighlights} unbolden unmarkmatches @@ -3582,12 +4577,22 @@ proc makepatterns {l} { proc do_file_hl {serial} { global highlight_files filehighlight highlight_paths gdttype fhl_list + global cdup findtype if {$gdttype eq [mc "touching paths:"]} { + # If "exact" match then convert backslashes to forward slashes. + # Most useful to support Windows-flavoured file paths. + if {$findtype eq [mc "Exact"]} { + set highlight_files [string map {"\\" "/"} $highlight_files] + } if {[catch {set paths [shellsplit $highlight_files]}]} return set highlight_paths [makepatterns $paths] highlight_filelist - set gdtargs [concat -- $paths] + set relative_paths {} + foreach path $paths { + lappend relative_paths [file join $cdup $path] + } + set gdtargs [concat -- $relative_paths] } elseif {$gdttype eq [mc "adding/removing string:"]} { set gdtargs [list "-S$highlight_files"] } else { @@ -3640,9 +4645,8 @@ proc readfhighlight {} { set fhl_list [lrange $fhl_list [expr {$i+1}] end] if {$line eq {}} continue if {![commitinview $line $curview]} continue - set row [rowofcommit $line] if {[info exists iddrawn($line)] && ![ishighlighted $line]} { - bolden $row mainfontbold + bolden $line mainfontbold } set fhighlights($line) 1 } @@ -3681,8 +4685,9 @@ proc askfindhighlight {row id} { } set info $commitinfo($id) set isbold 0 - set fldtypes [list [mc Headline] [mc Author] [mc Date] [mc Committer] [mc CDate] [mc Comments]] + set fldtypes [list [mc Headline] [mc Author] "" [mc Committer] "" [mc Comments]] foreach f $info ty $fldtypes { + if {$ty eq ""} continue if {($findloc eq [mc "All fields"] || $findloc eq $ty) && [doesmatch $f]} { if {$ty eq [mc "Author"]} { @@ -3694,9 +4699,9 @@ proc askfindhighlight {row id} { } if {$isbold && [info exists iddrawn($id)]} { if {![ishighlighted $id]} { - bolden $row mainfontbold + bolden $id mainfontbold if {$isbold > 1} { - bolden_name $row mainfontbold + bolden_name $id mainfontbold } } if {$markingmatches} { @@ -3716,15 +4721,15 @@ proc markrowmatches {row id} { if {$findloc eq [mc "All fields"] || $findloc eq [mc "Headline"]} { set m [findmatches $headline] if {$m ne {}} { - markmatches $canv $row $headline $linehtag($row) $m \ - [$canv itemcget $linehtag($row) -font] $row + markmatches $canv $row $headline $linehtag($id) $m \ + [$canv itemcget $linehtag($id) -font] $row } } if {$findloc eq [mc "All fields"] || $findloc eq [mc "Author"]} { set m [findmatches $author] if {$m ne {}} { - markmatches $canv2 $row $author $linentag($row) $m \ - [$canv2 itemcget $linentag($row) -font] $row + markmatches $canv2 $row $author $linentag($id) $m \ + [$canv2 itemcget $linentag($id) -font] $row } } } @@ -3849,7 +4854,7 @@ proc askrelhighlight {row id} { } if {[info exists iddrawn($id)]} { if {$isbold && ![ishighlighted $id]} { - bolden $row mainfontbold + bolden $id mainfontbold } } set rhighlights($id) $isbold @@ -4003,7 +5008,7 @@ proc visiblerows {} { proc layoutmore {} { global commitidx viewcomplete curview global numcommits pending_select curview - global lastscrollset lastscrollrows commitinterest + global lastscrollset lastscrollrows if {$lastscrollrows < 100 || $viewcomplete($curview) || [clock clicks -milliseconds] - $lastscrollset > 500} { @@ -4011,19 +5016,62 @@ proc layoutmore {} { } if {[info exists pending_select] && [commitinview $pending_select $curview]} { + update selectline [rowofcommit $pending_select] 1 } drawvisible } +# With path limiting, we mightn't get the actual HEAD commit, +# so ask git rev-list what is the first ancestor of HEAD that +# touches a file in the path limit. +proc get_viewmainhead {view} { + global viewmainheadid vfilelimit viewinstances mainheadid + + catch { + set rfd [open [concat | git rev-list -1 $mainheadid \ + -- $vfilelimit($view)] r] + set j [reg_instance $rfd] + lappend viewinstances($view) $j + fconfigure $rfd -blocking 0 + filerun $rfd [list getviewhead $rfd $j $view] + set viewmainheadid($curview) {} + } +} + +# git rev-list should give us just 1 line to use as viewmainheadid($view) +proc getviewhead {fd inst view} { + global viewmainheadid commfd curview viewinstances showlocalchanges + + set id {} + if {[gets $fd line] < 0} { + if {![eof $fd]} { + return 1 + } + } elseif {[string length $line] == 40 && [string is xdigit $line]} { + set id $line + } + set viewmainheadid($view) $id + close $fd + unset commfd($inst) + set i [lsearch -exact $viewinstances($view) $inst] + if {$i >= 0} { + set viewinstances($view) [lreplace $viewinstances($view) $i $i] + } + if {$showlocalchanges && $id ne {} && $view == $curview} { + doshowlocalchanges + } + return 0 +} + proc doshowlocalchanges {} { - global curview mainheadid + global curview viewmainheadid - if {$mainheadid eq {}} return - if {[commitinview $mainheadid $curview]} { + if {$viewmainheadid($curview) eq {}} return + if {[commitinview $viewmainheadid($curview) $curview]} { dodiffindex } else { - lappend commitinterest($mainheadid) {dodiffindex} + interestedin $viewmainheadid($curview) dodiffindex } } @@ -4041,18 +5089,24 @@ proc dohidelocalchanges {} { # spawn off a process to do git diff-index --cached HEAD proc dodiffindex {} { - global lserial showlocalchanges - global isworktree + global lserial showlocalchanges vfilelimit curview + global hasworktree - if {!$showlocalchanges || !$isworktree} return + if {!$showlocalchanges || !$hasworktree} return incr lserial - set fd [open "|git diff-index --cached HEAD" r] + set cmd "|git diff-index --cached HEAD" + if {$vfilelimit($curview) ne {}} { + set cmd [concat $cmd -- $vfilelimit($curview)] + } + set fd [open $cmd r] fconfigure $fd -blocking 0 - filerun $fd [list readdiffindex $fd $lserial] + set i [reg_instance $fd] + filerun $fd [list readdiffindex $fd $lserial $i] } -proc readdiffindex {fd serial} { - global mainheadid nullid nullid2 curview commitinfo commitdata lserial +proc readdiffindex {fd serial inst} { + global viewmainheadid nullid nullid2 curview commitinfo commitdata lserial + global vfilelimit set isdiff 1 if {[gets $fd line] < 0} { @@ -4062,16 +5116,21 @@ proc readdiffindex {fd serial} { set isdiff 0 } # we only need to see one line and we don't really care what it says... - close $fd + stop_instance $inst if {$serial != $lserial} { return 0 } # now see if there are any local changes not checked in to the index - set fd [open "|git diff-files" r] + set cmd "|git diff-files" + if {$vfilelimit($curview) ne {}} { + set cmd [concat $cmd -- $vfilelimit($curview)] + } + set fd [open $cmd r] fconfigure $fd -blocking 0 - filerun $fd [list readdifffiles $fd $serial] + set i [reg_instance $fd] + filerun $fd [list readdifffiles $fd $serial $i] if {$isdiff && ![commitinview $nullid2 $curview]} { # add the line for the changes in the index to the graph @@ -4081,15 +5140,18 @@ proc readdiffindex {fd serial} { if {[commitinview $nullid $curview]} { removefakerow $nullid } - insertfakerow $nullid2 $mainheadid + insertfakerow $nullid2 $viewmainheadid($curview) } elseif {!$isdiff && [commitinview $nullid2 $curview]} { + if {[commitinview $nullid $curview]} { + removefakerow $nullid + } removefakerow $nullid2 } return 0 } -proc readdifffiles {fd serial} { - global mainheadid nullid nullid2 curview +proc readdifffiles {fd serial inst} { + global viewmainheadid nullid nullid2 curview global commitinfo commitdata lserial set isdiff 1 @@ -4100,7 +5162,7 @@ proc readdifffiles {fd serial} { set isdiff 0 } # we only need to see one line and we don't really care what it says... - close $fd + stop_instance $inst if {$serial != $lserial} { return 0 @@ -4114,7 +5176,7 @@ proc readdifffiles {fd serial} { if {[commitinview $nullid2 $curview]} { set p $nullid2 } else { - set p $mainheadid + set p $viewmainheadid($curview) } insertfakerow $nullid $p } elseif {!$isdiff && [commitinview $nullid $curview]} { @@ -4839,8 +5901,8 @@ proc drawcmittext {id row col} { global cmitlisted commitinfo rowidlist parentlist global rowtextx idpos idtags idheads idotherrefs global linehtag linentag linedtag selectedline - global canvxmax boldrows boldnamerows fgcolor - global mainheadid nullid nullid2 circleitem circlecolors + global canvxmax boldids boldnameids fgcolor markedid + global mainheadid nullid nullid2 circleitem circlecolors ctxbut # listed is 0 for boundary, 1 for normal, 2 for negative, 3 for left, 4 for right set listed $cmitlisted($curview,$id) @@ -4896,6 +5958,9 @@ proc drawcmittext {id row col} { || [info exists idotherrefs($id)]} { set xt [drawtags $id $x $xt $y] } + if {[lindex $commitinfo($id) 6] > 0} { + set xt [drawnotesign $xt $y] + } set headline [lindex $commitinfo($id) 0] set name [lindex $commitinfo($id) 1] set date [lindex $commitinfo($id) 2] @@ -4904,22 +5969,25 @@ proc drawcmittext {id row col} { set nfont mainfont set isbold [ishighlighted $id] if {$isbold > 0} { - lappend boldrows $row + lappend boldids $id set font mainfontbold if {$isbold > 1} { - lappend boldnamerows $row + lappend boldnameids $id set nfont mainfontbold } } - set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \ - -text $headline -font $font -tags text] - $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id" - set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \ - -text $name -font $nfont -tags text] - set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \ - -text $date -font mainfont -tags text] + set linehtag($id) [$canv create text $xt $y -anchor w -fill $fgcolor \ + -text $headline -font $font -tags text] + $canv bind $linehtag($id) $ctxbut "rowmenu %X %Y $id" + set linentag($id) [$canv2 create text 3 $y -anchor w -fill $fgcolor \ + -text $name -font $nfont -tags text] + set linedtag($id) [$canv3 create text 3 $y -anchor w -fill $fgcolor \ + -text $date -font mainfont -tags text] if {$selectedline == $row} { - make_secsel $row + make_secsel $id + } + if {[info exists markedid] && $markedid eq $id} { + make_idmark $id } set xr [expr {$xt + [font measure $font $headline]}] if {$xr > $canvxmax} { @@ -5010,7 +6078,6 @@ proc drawcommits {row {endrow {}}} { optimize_rows $ro1 0 $r2 if {$need_redisplay || $nrows_drawn > 2000} { clear_display - drawvisible } # make the lines join to already-drawn rows either side @@ -5127,7 +6194,7 @@ proc drawvisible {} { proc clear_display {} { global iddrawn linesegs need_redisplay nrows_drawn global vhighlights fhighlights nhighlights rhighlights - global linehtag linentag linedtag boldrows boldnamerows + global linehtag linentag linedtag boldids boldnameids allcanvs delete all catch {unset iddrawn} @@ -5135,8 +6202,8 @@ proc clear_display {} { catch {unset linehtag} catch {unset linentag} catch {unset linedtag} - set boldrows {} - set boldnamerows {} + set boldids {} + set boldnameids {} catch {unset vhighlights} catch {unset fhighlights} catch {unset nhighlights} @@ -5255,7 +6322,7 @@ proc bindline {t id} { proc drawtags {id x xt y1} { global idtags idheads idotherrefs mainhead global linespc lthickness - global canv rowtextx curview fgcolor bgcolor + global canv rowtextx curview fgcolor bgcolor ctxbut set marks {} set ntags 0 @@ -5296,6 +6363,7 @@ proc drawtags {id x xt y1} { -width $lthickness -fill black -tags tag.$id] $canv lower $t foreach tag $marks x $xvals wid $wvals { + set tag_quoted [string map {% %%} $tag] set xl [expr {$x + $delta}] set xr [expr {$x + $delta + $wid + $lthickness}] set font mainfont @@ -5304,7 +6372,7 @@ proc drawtags {id x xt y1} { set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \ $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \ -width 1 -outline black -fill yellow -tags tag.$id] - $canv bind $t <1> [list showtag $tag 1] + $canv bind $t <1> [list showtag $tag_quoted 1] set rowtextx([rowofcommit $id]) [expr {$xr + $linespc}] } else { # draw a head or other ref @@ -5331,14 +6399,25 @@ proc drawtags {id x xt y1} { set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \ -font $font -tags [list tag.$id text]] if {$ntags >= 0} { - $canv bind $t <1> [list showtag $tag 1] + $canv bind $t <1> [list showtag $tag_quoted 1] } elseif {$nheads >= 0} { - $canv bind $t <Button-3> [list headmenu %X %Y $id $tag] + $canv bind $t $ctxbut [list headmenu %X %Y $id $tag_quoted] } } return $xt } +proc drawnotesign {xt y} { + global linespc canv fgcolor + + set orad [expr {$linespc / 3}] + set t [$canv create rectangle [expr {$xt - $orad}] [expr {$y - $orad}] \ + [expr {$xt + $orad - 1}] [expr {$y + $orad - 1}] \ + -fill yellow -outline $fgcolor -width 1 -tags circle] + set xt [expr {$xt + $orad * 3}] + return $xt +} + proc xcoord {i level ln} { global canvx0 xspc1 xspc2 @@ -5457,6 +6536,7 @@ proc stopfinding {} { set fprogcoord 0 adjustprogress } + stopblaming } proc findmore {} { @@ -5468,7 +6548,7 @@ proc findmore {} { if {![info exists find_dirn]} { return 0 } - set fldtypes [list [mc "Headline"] [mc "Author"] [mc "Date"] [mc "Committer"] [mc "CDate"] [mc "Comments"]] + set fldtypes [list [mc "Headline"] [mc "Author"] "" [mc "Committer"] "" [mc "Comments"]] set l $findcurline set moretodo 0 if {$find_dirn > 0} { @@ -5529,6 +6609,7 @@ proc findmore {} { } set info $commitinfo($id) foreach f $info ty $fldtypes { + if {$ty eq ""} continue if {($findloc eq [mc "All fields"] || $findloc eq $ty) && [doesmatch $f]} { set found 1 @@ -5593,10 +6674,11 @@ proc findmore {} { proc findselectline {l} { global findloc commentend ctext findcurline markingmatches gdttype - set markingmatches 1 + set markingmatches [expr {$gdttype eq [mc "containing:"]}] set findcurline $l selectline $l 1 - if {$findloc == [mc "All fields"] || $findloc == [mc "Comments"]} { + if {$markingmatches && + ($findloc eq [mc "All fields"] || $findloc eq [mc "Comments"])} { # highlight the matches in the comments set f [$ctext get 1.0 $commentend] set matches [findmatches $f] @@ -5676,11 +6758,11 @@ proc commit_descriptor {p} { # append some text to the ctext widget, and make any SHA1 ID # that we know about be a clickable link. proc appendwithlinks {text tags} { - global ctext linknum curview pendinglinks + global ctext linknum curview set start [$ctext index "end - 1c"] $ctext insert end $text $tags - set links [regexp -indices -all -inline {[0-9a-f]{40}} $text] + set links [regexp -indices -all -inline {(?:\m|-g)[0-9a-f]{6,40}\M} $text] foreach l $links { set s [lindex $l 0] set e [lindex $l 1] @@ -5694,19 +6776,45 @@ proc appendwithlinks {text tags} { } proc setlink {id lk} { - global curview ctext pendinglinks commitinterest + global curview ctext pendinglinks - if {[commitinview $id $curview]} { + if {[string range $id 0 1] eq "-g"} { + set id [string range $id 2 end] + } + + set known 0 + if {[string length $id] < 40} { + set matches [longid $id] + if {[llength $matches] > 0} { + if {[llength $matches] > 1} return + set known 1 + set id [lindex $matches 0] + } + } else { + set known [commitinview $id $curview] + } + if {$known} { $ctext tag conf $lk -foreground blue -underline 1 - $ctext tag bind $lk <1> [list selectline [rowofcommit $id] 1] + $ctext tag bind $lk <1> [list selbyid $id] $ctext tag bind $lk <Enter> {linkcursor %W 1} $ctext tag bind $lk <Leave> {linkcursor %W -1} } else { lappend pendinglinks($id) $lk - lappend commitinterest($id) {makelink %I} + interestedin $id {makelink %P} } } +proc appendshortlink {id {pre {}} {post {}}} { + global ctext linknum + + $ctext insert end $pre + $ctext tag delete link$linknum + $ctext insert end [string range $id 0 7] link$linknum + $ctext insert end $post + setlink $id link$linknum + incr linknum +} + proc makelink {id} { global pendinglinks @@ -5763,7 +6871,7 @@ proc appendrefs {pos ids var} { } } if {[llength $tags] > $maxrefs} { - $ctext insert $pos "many ([llength $tags])" + $ctext insert $pos "[mc "many"] ([llength $tags])" } else { set tags [lsort -index 0 -decreasing $tags] set sep {} @@ -5832,25 +6940,35 @@ proc dispnexttag {} { } } -proc make_secsel {l} { +proc make_secsel {id} { global linehtag linentag linedtag canv canv2 canv3 - if {![info exists linehtag($l)]} return + if {![info exists linehtag($id)]} return $canv delete secsel - set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \ + set t [eval $canv create rect [$canv bbox $linehtag($id)] -outline {{}} \ -tags secsel -fill [$canv cget -selectbackground]] $canv lower $t $canv2 delete secsel - set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \ + set t [eval $canv2 create rect [$canv2 bbox $linentag($id)] -outline {{}} \ -tags secsel -fill [$canv2 cget -selectbackground]] $canv2 lower $t $canv3 delete secsel - set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \ + set t [eval $canv3 create rect [$canv3 bbox $linedtag($id)] -outline {{}} \ -tags secsel -fill [$canv3 cget -selectbackground]] $canv3 lower $t } -proc selectline {l isnew} { +proc make_idmark {id} { + global linehtag canv fgcolor + + if {![info exists linehtag($id)]} return + $canv delete markid + set t [eval $canv create rect [$canv bbox $linehtag($id)] \ + -tags markid -outline $fgcolor] + $canv raise $t +} + +proc selectline {l isnew {desired_loc {}}} { global canv ctext commitinfo selectedline global canvy0 linespc parents children curview global currentid sha1entry @@ -5858,7 +6976,7 @@ proc selectline {l isnew} { global mergemax numcommits pending_select global cmitmode showneartags allcommits global targetrow targetid lastscrollrows - global autoselect + global autoselect autosellen jump_to_here catch {unset pending_select} $canv delete hover @@ -5911,17 +7029,16 @@ proc selectline {l isnew} { drawvisible } - make_secsel $l + make_secsel $id if {$isnew} { - addtohistory [list selbyid $id] + addtohistory [list selbyid $id 0] savecmitpos } $sha1entry delete 0 end $sha1entry insert 0 $id if {$autoselect} { - $sha1entry selection from 0 - $sha1entry selection to end + $sha1entry selection range 0 $autosellen } rhighlight_sel $id @@ -5997,6 +7114,7 @@ proc selectline {l isnew} { $ctext conf -state disabled set commentend [$ctext index "end - 1c"] + set jump_to_here $desired_loc init_flist [mc "Comments"] if {$cmitmode eq "tree"} { gettree $id @@ -6065,10 +7183,12 @@ proc reselectline {} { } } -proc addtohistory {cmd} { +proc addtohistory {cmd {saveproc {}}} { global history historyindex curview - set elt [list $curview $cmd] + unset_posvars + save_position + set elt [list $curview $cmd $saveproc {}] if {$historyindex > 0 && [lindex $history [expr {$historyindex - 1}]] == $elt} { return @@ -6088,14 +7208,45 @@ proc addtohistory {cmd} { .tf.bar.rightbut conf -state disabled } +# save the scrolling position of the diff display pane +proc save_position {} { + global historyindex history + + if {$historyindex < 1} return + set hi [expr {$historyindex - 1}] + set fn [lindex $history $hi 2] + if {$fn ne {}} { + lset history $hi 3 [eval $fn] + } +} + +proc unset_posvars {} { + global last_posvars + + if {[info exists last_posvars]} { + foreach {var val} $last_posvars { + global $var + catch {unset $var} + } + unset last_posvars + } +} + proc godo {elt} { - global curview + global curview last_posvars set view [lindex $elt 0] set cmd [lindex $elt 1] + set pv [lindex $elt 3] if {$curview != $view} { showview $view } + unset_posvars + foreach {var val} $pv { + global $var + set $var $val + } + set last_posvars $pv eval $cmd } @@ -6104,6 +7255,7 @@ proc goback {} { focus . if {$historyindex > 1} { + save_position incr historyindex -1 godo [lindex $history [expr {$historyindex - 1}]] .tf.bar.rightbut conf -state normal @@ -6118,6 +7270,7 @@ proc goforw {} { focus . if {$historyindex < [llength $history]} { + save_position set cmd [lindex $history $historyindex] incr historyindex godo $cmd @@ -6149,7 +7302,7 @@ proc gettree {id} { set treepending $id set treefilelist($id) {} set treeidlist($id) {} - fconfigure $gtf -blocking 0 + fconfigure $gtf -blocking 0 -encoding binary filerun $gtf [list gettreeline $gtf $id] } } else { @@ -6171,11 +7324,12 @@ proc gettreeline {gtf id} { set line [string range $line 0 [expr {$i-1}]] if {$diffids ne $nullid2 && [lindex $line 1] ne "blob"} continue set sha1 [lindex $line 2] - if {[string index $fname 0] eq "\""} { - set fname [lindex $fname 0] - } lappend treeidlist($id) $sha1 } + if {[string index $fname 0] eq "\""} { + set fname [lindex $fname 0] + } + set fname [encoding convertfrom $fname] lappend treefilelist($id) $fname } if {![eof $gtf]} { @@ -6197,6 +7351,7 @@ proc gettreeline {gtf id} { proc showfile {f} { global treefilelist treeidlist diffids nullid nullid2 + global ctext_file_names ctext_file_lines global ctext commentend set i [lsearch -exact $treefilelist($diffids) $f] @@ -6216,10 +7371,12 @@ proc showfile {f} { return } } - fconfigure $bf -blocking 0 + fconfigure $bf -blocking 0 -encoding [get_path_encoding $f] filerun $bf [list getblobline $bf $diffids] $ctext config -state normal clear_ctext $commentend + lappend ctext_file_names $f + lappend ctext_file_lines [lindex [split $commentend "."] 0] $ctext insert end "\n" $ctext insert end "$f\n" filesep $ctext config -state disabled @@ -6240,109 +7397,44 @@ proc getblobline {bf id} { $ctext insert end "$line\n" } if {[eof $bf]} { + global jump_to_here ctext_file_names commentend + # delete last newline $ctext delete "end - 2c" "end - 1c" close $bf + if {$jump_to_here ne {} && + [lindex $jump_to_here 0] eq [lindex $ctext_file_names 0]} { + set lnum [expr {[lindex $jump_to_here 1] + + [lindex [split $commentend .] 0]}] + mark_ctext_line $lnum + } + $ctext config -state disabled return 0 } $ctext config -state disabled return [expr {$nl >= 1000? 2: 1}] } +proc mark_ctext_line {lnum} { + global ctext markbgcolor + + $ctext tag delete omark + $ctext tag add omark $lnum.0 "$lnum.0 + 1 line" + $ctext tag conf omark -background $markbgcolor + $ctext see $lnum.0 +} + proc mergediff {id} { - global diffmergeid mdifffd - global diffids - global parents - global diffcontext - global limitdiffs vfilelimit curview + global diffmergeid + global diffids treediffs + global parents curview set diffmergeid $id set diffids $id - # this doesn't seem to actually affect anything... - set cmd [concat | git diff-tree --no-commit-id --cc -U$diffcontext $id] - if {$limitdiffs && $vfilelimit($curview) ne {}} { - set cmd [concat $cmd -- $vfilelimit($curview)] - } - if {[catch {set mdf [open $cmd r]} err]} { - error_popup "[mc "Error getting merge diffs:"] $err" - return - } - fconfigure $mdf -blocking 0 - set mdifffd($id) $mdf + set treediffs($id) {} set np [llength $parents($curview,$id)] settabs $np - filerun $mdf [list getmergediffline $mdf $id $np] -} - -proc getmergediffline {mdf id np} { - global diffmergeid ctext cflist mergemax - global difffilestart mdifffd - - $ctext conf -state normal - set nr 0 - while {[incr nr] <= 1000 && [gets $mdf line] >= 0} { - if {![info exists diffmergeid] || $id != $diffmergeid - || $mdf != $mdifffd($id)} { - close $mdf - return 0 - } - if {[regexp {^diff --cc (.*)} $line match fname]} { - # start of a new file - $ctext insert end "\n" - set here [$ctext index "end - 1c"] - lappend difffilestart $here - add_flist [list $fname] - set l [expr {(78 - [string length $fname]) / 2}] - set pad [string range "----------------------------------------" 1 $l] - $ctext insert end "$pad $fname $pad\n" filesep - } elseif {[regexp {^@@} $line]} { - $ctext insert end "$line\n" hunksep - } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} { - # do nothing - } else { - # parse the prefix - one ' ', '-' or '+' for each parent - set spaces {} - set minuses {} - set pluses {} - set isbad 0 - for {set j 0} {$j < $np} {incr j} { - set c [string range $line $j $j] - if {$c == " "} { - lappend spaces $j - } elseif {$c == "-"} { - lappend minuses $j - } elseif {$c == "+"} { - lappend pluses $j - } else { - set isbad 1 - break - } - } - set tags {} - set num {} - if {!$isbad && $minuses ne {} && $pluses eq {}} { - # line doesn't appear in result, parents in $minuses have the line - set num [lindex $minuses 0] - } elseif {!$isbad && $pluses ne {} && $minuses eq {}} { - # line appears in result, parents in $pluses don't have the line - lappend tags mresult - set num [lindex $spaces 0] - } - if {$num ne {}} { - if {$num >= $mergemax} { - set num "max" - } - lappend tags m$num - } - $ctext insert end "$line\n" $tags - } - } - $ctext conf -state disabled - if {[eof $mdf]} { - close $mdf - return 0 - } - return [expr {$nr >= 1000? 2: 1}] + getblobdiffs $id } proc startdiff {ids} { @@ -6362,19 +7454,15 @@ proc startdiff {ids} { } } +# If the filename (name) is under any of the passed filter paths +# then return true to include the file in the listing. proc path_filter {filter name} { + set worktree [gitworktree] foreach p $filter { - set l [string length $p] - if {[string index $p end] eq "/"} { - if {[string compare -length $l $p $name] == 0} { - return 1 - } - } else { - if {[string compare -length $l $p $name] == 0 && - ([string length $name] == $l || - [string index $name $l] eq "/")} { - return 1 - } + set fq_p [file normalize $p] + set fq_n [file normalize [file join $worktree $name]] + if {[string match [file normalize $fq_p]* $fq_n]} { + return 1 } } return 0 @@ -6388,7 +7476,7 @@ proc addtocflist {ids} { } proc diffcmd {ids flags} { - global nullid nullid2 + global log_showroot nullid nullid2 set i [lsearch -exact $ids $nullid] set j [lsearch -exact $ids $nullid2] @@ -6412,7 +7500,7 @@ proc diffcmd {ids flags} { set cmd [concat | git diff-index --cached $flags] if {[llength $ids] > 1} { # comparing index with specific revision - if {$i == 0} { + if {$j == 0} { lappend cmd -R [lindex $ids 1] } else { lappend cmd [lindex $ids 0] @@ -6422,6 +7510,9 @@ proc diffcmd {ids flags} { lappend cmd HEAD } } else { + if {$log_showroot} { + lappend flags --root + } set cmd [concat | git diff-tree -r $flags $ids] } return $cmd @@ -6430,30 +7521,48 @@ proc diffcmd {ids flags} { proc gettreediffs {ids} { global treediff treepending + if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return + set treepending $ids set treediff {} - if {[catch {set gdtf [open [diffcmd $ids {--no-commit-id}] r]}]} return - fconfigure $gdtf -blocking 0 + fconfigure $gdtf -blocking 0 -encoding binary filerun $gdtf [list gettreediffline $gdtf $ids] } proc gettreediffline {gdtf ids} { global treediff treediffs treepending diffids diffmergeid - global cmitmode vfilelimit curview limitdiffs + global cmitmode vfilelimit curview limitdiffs perfile_attrs set nr 0 - while {[incr nr] <= 1000 && [gets $gdtf line] >= 0} { + set sublist {} + set max 1000 + if {$perfile_attrs} { + # cache_gitattr is slow, and even slower on win32 where we + # have to invoke it for only about 30 paths at a time + set max 500 + if {[tk windowingsystem] == "win32"} { + set max 120 + } + } + while {[incr nr] <= $max && [gets $gdtf line] >= 0} { set i [string first "\t" $line] if {$i >= 0} { set file [string range $line [expr {$i+1}] end] if {[string index $file 0] eq "\""} { set file [lindex $file 0] } - lappend treediff $file + set file [encoding convertfrom $file] + if {$file ne [lindex $treediff end]} { + lappend treediff $file + lappend sublist $file + } } } + if {$perfile_attrs} { + cache_gitattr encoding $sublist + } if {![eof $gdtf]} { - return [expr {$nr >= 1000? 2: 1}] + return [expr {$nr >= $max? 2: 1}] } close $gdtf if {$limitdiffs && $vfilelimit($curview) ne {}} { @@ -6468,7 +7577,7 @@ proc gettreediffline {gdtf ids} { set treediffs($ids) $treediff } unset treepending - if {$cmitmode eq "tree"} { + if {$cmitmode eq "tree" && [llength $diffids] == 1} { gettree $diffids } elseif {$ids != $diffids} { if {![info exists diffmergeid]} { @@ -6489,7 +7598,7 @@ proc diffcontextchange {n1 n2 op} { global diffcontextstring diffcontext if {[string is integer -strict $diffcontextstring]} { - if {$diffcontextstring > 0} { + if {$diffcontextstring >= 0} { set diffcontext $diffcontextstring reselectline } @@ -6500,30 +7609,80 @@ proc changeignorespace {} { reselectline } +proc changeworddiff {name ix op} { + reselectline +} + proc getblobdiffs {ids} { global blobdifffd diffids env global diffinhdr treediffs global diffcontext global ignorespace + global worddiff global limitdiffs vfilelimit curview + global diffencoding targetline diffnparents + global git_version currdiffsubmod - set cmd [diffcmd $ids "-p -C --no-commit-id -U$diffcontext"] + set textconv {} + if {[package vcompare $git_version "1.6.1"] >= 0} { + set textconv "--textconv" + } + set submodule {} + if {[package vcompare $git_version "1.6.6"] >= 0} { + set submodule "--submodule" + } + set cmd [diffcmd $ids "-p $textconv $submodule -C --cc --no-commit-id -U$diffcontext"] if {$ignorespace} { append cmd " -w" } + if {$worddiff ne [mc "Line diff"]} { + append cmd " --word-diff=porcelain" + } if {$limitdiffs && $vfilelimit($curview) ne {}} { set cmd [concat $cmd -- $vfilelimit($curview)] } if {[catch {set bdf [open $cmd r]} err]} { - puts "error getting diffs: $err" + error_popup [mc "Error getting diffs: %s" $err] return } + set targetline {} + set diffnparents 0 set diffinhdr 0 - fconfigure $bdf -blocking 0 + set diffencoding [get_path_encoding {}] + fconfigure $bdf -blocking 0 -encoding binary -eofchar {} set blobdifffd($ids) $bdf + set currdiffsubmod "" filerun $bdf [list getblobdiffline $bdf $diffids] } +proc savecmitpos {} { + global ctext cmitmode + + if {$cmitmode eq "tree"} { + return {} + } + return [list target_scrollpos [$ctext index @0,0]] +} + +proc savectextpos {} { + global ctext + + return [list target_scrollpos [$ctext index @0,0]] +} + +proc maybe_scroll_ctext {ateof} { + global ctext target_scrollpos + + if {![info exists target_scrollpos]} return + if {!$ateof} { + set nlines [expr {[winfo height $ctext] + / [font metrics textfont -linespace]}] + if {[$ctext compare "$target_scrollpos + $nlines lines" <= end]} return + } + $ctext yview $target_scrollpos + unset target_scrollpos +} + proc setinlist {var i val} { global $var @@ -6538,71 +7697,146 @@ proc setinlist {var i val} { } proc makediffhdr {fname ids} { - global ctext curdiffstart treediffs + global ctext curdiffstart treediffs diffencoding + global ctext_file_names jump_to_here targetline diffline + set fname [encoding convertfrom $fname] + set diffencoding [get_path_encoding $fname] set i [lsearch -exact $treediffs($ids) $fname] if {$i >= 0} { setinlist difffilestart $i $curdiffstart } + lset ctext_file_names end $fname set l [expr {(78 - [string length $fname]) / 2}] set pad [string range "----------------------------------------" 1 $l] $ctext insert $curdiffstart "$pad $fname $pad" filesep + set targetline {} + if {$jump_to_here ne {} && [lindex $jump_to_here 0] eq $fname} { + set targetline [lindex $jump_to_here 1] + } + set diffline 0 } proc getblobdiffline {bdf ids} { global diffids blobdifffd ctext curdiffstart global diffnexthead diffnextnote difffilestart - global diffinhdr treediffs + global ctext_file_names ctext_file_lines + global diffinhdr treediffs mergemax diffnparents + global diffencoding jump_to_here targetline diffline currdiffsubmod + global worddiff set nr 0 $ctext conf -state normal while {[incr nr] <= 1000 && [gets $bdf line] >= 0} { if {$ids != $diffids || $bdf != $blobdifffd($ids)} { - close $bdf + catch {close $bdf} return 0 } - if {![string compare -length 11 "diff --git " $line]} { - # trim off "diff --git " - set line [string range $line 11 end] - set diffinhdr 1 + if {![string compare -length 5 "diff " $line]} { + if {![regexp {^diff (--cc|--git) } $line m type]} { + set line [encoding convertfrom $line] + $ctext insert end "$line\n" hunksep + continue + } # start of a new file + set diffinhdr 1 $ctext insert end "\n" set curdiffstart [$ctext index "end - 1c"] + lappend ctext_file_names "" + lappend ctext_file_lines [lindex [split $curdiffstart "."] 0] $ctext insert end "\n" filesep - # If the name hasn't changed the length will be odd, - # the middle char will be a space, and the two bits either - # side will be a/name and b/name, or "a/name" and "b/name". - # If the name has changed we'll get "rename from" and - # "rename to" or "copy from" and "copy to" lines following this, - # and we'll use them to get the filenames. - # This complexity is necessary because spaces in the filename(s) - # don't get escaped. - set l [string length $line] - set i [expr {$l / 2}] - if {!(($l & 1) && [string index $line $i] eq " " && - [string range $line 2 [expr {$i - 1}]] eq \ - [string range $line [expr {$i + 3}] end])} { - continue - } - # unescape if quoted and chop off the a/ from the front - if {[string index $line 0] eq "\""} { - set fname [string range [lindex $line 0] 2 end] + + if {$type eq "--cc"} { + # start of a new file in a merge diff + set fname [string range $line 10 end] + if {[lsearch -exact $treediffs($ids) $fname] < 0} { + lappend treediffs($ids) $fname + add_flist [list $fname] + } + } else { - set fname [string range $line 2 [expr {$i - 1}]] + set line [string range $line 11 end] + # If the name hasn't changed the length will be odd, + # the middle char will be a space, and the two bits either + # side will be a/name and b/name, or "a/name" and "b/name". + # If the name has changed we'll get "rename from" and + # "rename to" or "copy from" and "copy to" lines following + # this, and we'll use them to get the filenames. + # This complexity is necessary because spaces in the + # filename(s) don't get escaped. + set l [string length $line] + set i [expr {$l / 2}] + if {!(($l & 1) && [string index $line $i] eq " " && + [string range $line 2 [expr {$i - 1}]] eq \ + [string range $line [expr {$i + 3}] end])} { + continue + } + # unescape if quoted and chop off the a/ from the front + if {[string index $line 0] eq "\""} { + set fname [string range [lindex $line 0] 2 end] + } else { + set fname [string range $line 2 [expr {$i - 1}]] + } } makediffhdr $fname $ids - } elseif {[regexp {^@@ -([0-9]+)(,[0-9]+)? \+([0-9]+)(,[0-9]+)? @@(.*)} \ - $line match f1l f1c f2l f2c rest]} { + } elseif {![string compare -length 16 "* Unmerged path " $line]} { + set fname [encoding convertfrom [string range $line 16 end]] + $ctext insert end "\n" + set curdiffstart [$ctext index "end - 1c"] + lappend ctext_file_names $fname + lappend ctext_file_lines [lindex [split $curdiffstart "."] 0] + $ctext insert end "$line\n" filesep + set i [lsearch -exact $treediffs($ids) $fname] + if {$i >= 0} { + setinlist difffilestart $i $curdiffstart + } + + } elseif {![string compare -length 2 "@@" $line]} { + regexp {^@@+} $line ats + set line [encoding convertfrom $diffencoding $line] $ctext insert end "$line\n" hunksep + if {[regexp { \+(\d+),\d+ @@} $line m nl]} { + set diffline $nl + } + set diffnparents [expr {[string length $ats] - 1}] set diffinhdr 0 + } elseif {![string compare -length 10 "Submodule " $line]} { + # start of a new submodule + if {[regexp -indices "\[0-9a-f\]+\\.\\." $line nameend]} { + set fname [string range $line 10 [expr [lindex $nameend 0] - 2]] + } else { + set fname [string range $line 10 [expr [string first "contains " $line] - 2]] + } + if {$currdiffsubmod != $fname} { + $ctext insert end "\n"; # Add newline after commit message + } + set curdiffstart [$ctext index "end - 1c"] + lappend ctext_file_names "" + if {$currdiffsubmod != $fname} { + lappend ctext_file_lines $fname + makediffhdr $fname $ids + set currdiffsubmod $fname + $ctext insert end "\n$line\n" filesep + } else { + $ctext insert end "$line\n" filesep + } + } elseif {![string compare -length 3 " >" $line]} { + set $currdiffsubmod "" + set line [encoding convertfrom $diffencoding $line] + $ctext insert end "$line\n" dresult + } elseif {![string compare -length 3 " <" $line]} { + set $currdiffsubmod "" + set line [encoding convertfrom $diffencoding $line] + $ctext insert end "$line\n" d0 } elseif {$diffinhdr} { if {![string compare -length 12 "rename from " $line]} { set fname [string range $line [expr 6 + [string first " from " $line] ] end] if {[string index $fname 0] eq "\""} { set fname [lindex $fname 0] } + set fname [encoding convertfrom $fname] set i [lsearch -exact $treediffs($ids) $fname] if {$i >= 0} { setinlist difffilestart $i $curdiffstart @@ -6624,12 +7858,69 @@ proc getblobdiffline {bdf ids} { $ctext insert end "$line\n" filesep } else { - set x [string range $line 0 0] - if {$x == "-" || $x == "+"} { - set tag [expr {$x == "+"}] - $ctext insert end "$line\n" d$tag - } elseif {$x == " "} { - $ctext insert end "$line\n" + set line [string map {\x1A ^Z} \ + [encoding convertfrom $diffencoding $line]] + # parse the prefix - one ' ', '-' or '+' for each parent + set prefix [string range $line 0 [expr {$diffnparents - 1}]] + set tag [expr {$diffnparents > 1? "m": "d"}] + set dowords [expr {$worddiff ne [mc "Line diff"] && $diffnparents == 1}] + set words_pre_markup "" + set words_post_markup "" + if {[string trim $prefix " -+"] eq {}} { + # prefix only has " ", "-" and "+" in it: normal diff line + set num [string first "-" $prefix] + if {$dowords} { + set line [string range $line 1 end] + } + if {$num >= 0} { + # removed line, first parent with line is $num + if {$num >= $mergemax} { + set num "max" + } + if {$dowords && $worddiff eq [mc "Markup words"]} { + $ctext insert end "\[-$line-\]" $tag$num + } else { + $ctext insert end "$line" $tag$num + } + if {!$dowords} { + $ctext insert end "\n" $tag$num + } + } else { + set tags {} + if {[string first "+" $prefix] >= 0} { + # added line + lappend tags ${tag}result + if {$diffnparents > 1} { + set num [string first " " $prefix] + if {$num >= 0} { + if {$num >= $mergemax} { + set num "max" + } + lappend tags m$num + } + } + set words_pre_markup "{+" + set words_post_markup "+}" + } + if {$targetline ne {}} { + if {$diffline == $targetline} { + set seehere [$ctext index "end - 1 chars"] + set targetline {} + } else { + incr diffline + } + } + if {$dowords && $worddiff eq [mc "Markup words"]} { + $ctext insert end "$words_pre_markup$line$words_post_markup" $tags + } else { + $ctext insert end "$line" $tags + } + if {!$dowords} { + $ctext insert end "\n" $tags + } + } + } elseif {$dowords && $prefix eq "~"} { + $ctext insert end "\n" {} } else { # "\ No newline at end of file", # or something else we don't recognize @@ -6637,9 +7928,13 @@ proc getblobdiffline {bdf ids} { } } } + if {[info exists seehere]} { + mark_ctext_line [lindex [split $seehere .] 0] + } + maybe_scroll_ctext [eof $bdf] $ctext conf -state disabled if {[eof $bdf]} { - close $bdf + catch {close $bdf} return 0 } return [expr {$nr >= 1000? 2: 1}] @@ -6649,7 +7944,7 @@ proc changediffdisp {} { global ctext diffelide $ctext tag conf d0 -elide [lindex $diffelide 0] - $ctext tag conf d1 -elide [lindex $diffelide 1] + $ctext tag conf dresult -elide [lindex $diffelide 1] } proc highlightfile {loc cline} { @@ -6697,6 +7992,7 @@ proc nextfile {} { proc clear_ctext {{first 1.0}} { global ctext smarktop smarkbot + global ctext_file_names ctext_file_lines global pendinglinks set l [lindex [split $first .] 0] @@ -6710,6 +8006,8 @@ proc clear_ctext {{first 1.0}} { if {$first eq "1.0"} { catch {unset pendinglinks} } + set ctext_file_names {} + set ctext_file_lines {} } proc settabs {{firstab {}}} { @@ -6985,13 +8283,18 @@ proc gotocommit {} { } else { set id [string tolower $sha1string] if {[regexp {^[0-9a-f]{4,39}$} $id]} { - set matches [array names varcid "$curview,$id*"] + set matches [longid $id] if {$matches ne {}} { if {[llength $matches] > 1} { error_popup [mc "Short SHA1 id %s is ambiguous" $id] return } - set id [lindex [split [lindex $matches 0] ","] 1] + set id [lindex $matches 0] + } + } else { + if {[catch {set id [exec git rev-parse --verify $sha1string]}]} { + error_popup [mc "Revision %s is not known" $sha1string] + return } } } @@ -7002,7 +8305,7 @@ proc gotocommit {} { if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} { set msg [mc "SHA1 id %s is not known" $sha1string] } else { - set msg [mc "Tag/Head %s is not known" $sha1string] + set msg [mc "Revision %s is not in the current view" $sha1string] } error_popup $msg } @@ -7128,7 +8431,7 @@ proc lineclick {x y id isnew} { } if {$isnew} { - addtohistory [list lineclick $x $y $id 0] + addtohistory [list lineclick $x $y $id 0] savectextpos } # fill the details pane with info about this line $ctext conf -state normal @@ -7159,6 +8462,7 @@ proc lineclick {x y id isnew} { $ctext insert end "\n\t[mc "Date"]:\t$date\n" } } + maybe_scroll_ctext 1 $ctext conf -state disabled init_flist {} } @@ -7172,10 +8476,10 @@ proc normalline {} { } } -proc selbyid {id} { +proc selbyid {id {isnew 1}} { global curview if {[commitinview $id $curview]} { - selectline [rowofcommit $id] 1 + selectline [rowofcommit $id] $isnew } } @@ -7189,7 +8493,7 @@ proc mstime {} { proc rowmenu {x y id} { global rowctxmenu selectedline rowmenuid curview - global nullid nullid2 fakerowmenu mainhead + global nullid nullid2 fakerowmenu mainhead markedid stopfinding set rowmenuid $id @@ -7198,22 +8502,217 @@ proc rowmenu {x y id} { } else { set state normal } + if {[info exists markedid] && $markedid ne $id} { + set mstate normal + } else { + set mstate disabled + } if {$id ne $nullid && $id ne $nullid2} { set menu $rowctxmenu if {$mainhead ne {}} { - $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] + $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal } else { $menu entryconfigure 7 -label [mc "Detached head: can't reset" $mainhead] -state disabled } + $menu entryconfigure 9 -state $mstate + $menu entryconfigure 10 -state $mstate + $menu entryconfigure 11 -state $mstate } else { set menu $fakerowmenu } - $menu entryconfigure [mc "Diff this -> selected"] -state $state - $menu entryconfigure [mc "Diff selected -> this"] -state $state - $menu entryconfigure [mc "Make patch"] -state $state + $menu entryconfigure [mca "Diff this -> selected"] -state $state + $menu entryconfigure [mca "Diff selected -> this"] -state $state + $menu entryconfigure [mca "Make patch"] -state $state + $menu entryconfigure [mca "Diff this -> marked commit"] -state $mstate + $menu entryconfigure [mca "Diff marked commit -> this"] -state $mstate tk_popup $menu $x $y } +proc markhere {} { + global rowmenuid markedid canv + + set markedid $rowmenuid + make_idmark $markedid +} + +proc gotomark {} { + global markedid + + if {[info exists markedid]} { + selbyid $markedid + } +} + +proc replace_by_kids {l r} { + global curview children + + set id [commitonrow $r] + set l [lreplace $l 0 0] + foreach kid $children($curview,$id) { + lappend l [rowofcommit $kid] + } + return [lsort -integer -decreasing -unique $l] +} + +proc find_common_desc {} { + global markedid rowmenuid curview children + + if {![info exists markedid]} return + if {![commitinview $markedid $curview] || + ![commitinview $rowmenuid $curview]} return + #set t1 [clock clicks -milliseconds] + set l1 [list [rowofcommit $markedid]] + set l2 [list [rowofcommit $rowmenuid]] + while 1 { + set r1 [lindex $l1 0] + set r2 [lindex $l2 0] + if {$r1 eq {} || $r2 eq {}} break + if {$r1 == $r2} { + selectline $r1 1 + break + } + if {$r1 > $r2} { + set l1 [replace_by_kids $l1 $r1] + } else { + set l2 [replace_by_kids $l2 $r2] + } + } + #set t2 [clock clicks -milliseconds] + #puts "took [expr {$t2-$t1}]ms" +} + +proc compare_commits {} { + global markedid rowmenuid curview children + + if {![info exists markedid]} return + if {![commitinview $markedid $curview]} return + addtohistory [list do_cmp_commits $markedid $rowmenuid] + do_cmp_commits $markedid $rowmenuid +} + +proc getpatchid {id} { + global patchids + + if {![info exists patchids($id)]} { + set cmd [diffcmd [list $id] {-p --root}] + # trim off the initial "|" + set cmd [lrange $cmd 1 end] + if {[catch { + set x [eval exec $cmd | git patch-id] + set patchids($id) [lindex $x 0] + }]} { + set patchids($id) "error" + } + } + return $patchids($id) +} + +proc do_cmp_commits {a b} { + global ctext curview parents children patchids commitinfo + + $ctext conf -state normal + clear_ctext + init_flist {} + for {set i 0} {$i < 100} {incr i} { + set skipa 0 + set skipb 0 + if {[llength $parents($curview,$a)] > 1} { + appendshortlink $a [mc "Skipping merge commit "] "\n" + set skipa 1 + } else { + set patcha [getpatchid $a] + } + if {[llength $parents($curview,$b)] > 1} { + appendshortlink $b [mc "Skipping merge commit "] "\n" + set skipb 1 + } else { + set patchb [getpatchid $b] + } + if {!$skipa && !$skipb} { + set heada [lindex $commitinfo($a) 0] + set headb [lindex $commitinfo($b) 0] + if {$patcha eq "error"} { + appendshortlink $a [mc "Error getting patch ID for "] \ + [mc " - stopping\n"] + break + } + if {$patchb eq "error"} { + appendshortlink $b [mc "Error getting patch ID for "] \ + [mc " - stopping\n"] + break + } + if {$patcha eq $patchb} { + if {$heada eq $headb} { + appendshortlink $a [mc "Commit "] + appendshortlink $b " == " " $heada\n" + } else { + appendshortlink $a [mc "Commit "] " $heada\n" + appendshortlink $b [mc " is the same patch as\n "] \ + " $headb\n" + } + set skipa 1 + set skipb 1 + } else { + $ctext insert end "\n" + appendshortlink $a [mc "Commit "] " $heada\n" + appendshortlink $b [mc " differs from\n "] \ + " $headb\n" + $ctext insert end [mc "Diff of commits:\n\n"] + $ctext conf -state disabled + update + diffcommits $a $b + return + } + } + if {$skipa} { + set kids [real_children $curview,$a] + if {[llength $kids] != 1} { + $ctext insert end "\n" + appendshortlink $a [mc "Commit "] \ + [mc " has %s children - stopping\n" [llength $kids]] + break + } + set a [lindex $kids 0] + } + if {$skipb} { + set kids [real_children $curview,$b] + if {[llength $kids] != 1} { + appendshortlink $b [mc "Commit "] \ + [mc " has %s children - stopping\n" [llength $kids]] + break + } + set b [lindex $kids 0] + } + } + $ctext conf -state disabled +} + +proc diffcommits {a b} { + global diffcontext diffids blobdifffd diffinhdr currdiffsubmod + + set tmpdir [gitknewtmpdir] + set fna [file join $tmpdir "commit-[string range $a 0 7]"] + set fnb [file join $tmpdir "commit-[string range $b 0 7]"] + if {[catch { + exec git diff-tree -p --pretty $a >$fna + exec git diff-tree -p --pretty $b >$fnb + } err]} { + error_popup [mc "Error writing commit to file: %s" $err] + return + } + if {[catch { + set fd [open "| diff -U$diffcontext $fna $fnb" r] + } err]} { + error_popup [mc "Error diffing commits: %s" $err] + return + } + set diffids [list commits $a $b] + set blobdifffd($diffids) $fd + set diffinhdr 0 + set currdiffsubmod "" + filerun $fd [list getblobdiffline $fd $diffids] +} + proc diffvssel {dirn} { global rowmenuid selectedline @@ -7225,7 +8724,22 @@ proc diffvssel {dirn} { set oldid $rowmenuid set newid [commitonrow $selectedline] } - addtohistory [list doseldiff $oldid $newid] + addtohistory [list doseldiff $oldid $newid] savectextpos + doseldiff $oldid $newid +} + +proc diffvsmark {dirn} { + global rowmenuid markedid + + if {![info exists markedid]} return + if {$dirn} { + set oldid $markedid + set newid $rowmenuid + } else { + set oldid $rowmenuid + set newid $markedid + } + addtohistory [list doseldiff $oldid $newid] savectextpos doseldiff $oldid $newid } @@ -7253,7 +8767,7 @@ proc doseldiff {oldid newid} { } proc mkpatch {} { - global rowmenuid currentid commitinfo patchtop patchnum + global rowmenuid currentid commitinfo patchtop patchnum NS if {![info exists currentid]} return set oldid $currentid @@ -7263,37 +8777,40 @@ proc mkpatch {} { set top .patch set patchtop $top catch {destroy $top} - toplevel $top - label $top.title -text [mc "Generate patch"] + ttk_toplevel $top + make_transient $top . + ${NS}::label $top.title -text [mc "Generate patch"] grid $top.title - -pady 10 - label $top.from -text [mc "From:"] - entry $top.fromsha1 -width 40 -relief flat + ${NS}::label $top.from -text [mc "From:"] + ${NS}::entry $top.fromsha1 -width 40 $top.fromsha1 insert 0 $oldid $top.fromsha1 conf -state readonly grid $top.from $top.fromsha1 -sticky w - entry $top.fromhead -width 60 -relief flat + ${NS}::entry $top.fromhead -width 60 $top.fromhead insert 0 $oldhead $top.fromhead conf -state readonly grid x $top.fromhead -sticky w - label $top.to -text [mc "To:"] - entry $top.tosha1 -width 40 -relief flat + ${NS}::label $top.to -text [mc "To:"] + ${NS}::entry $top.tosha1 -width 40 $top.tosha1 insert 0 $newid $top.tosha1 conf -state readonly grid $top.to $top.tosha1 -sticky w - entry $top.tohead -width 60 -relief flat + ${NS}::entry $top.tohead -width 60 $top.tohead insert 0 $newhead $top.tohead conf -state readonly grid x $top.tohead -sticky w - button $top.rev -text [mc "Reverse"] -command mkpatchrev -padx 5 - grid $top.rev x -pady 10 - label $top.flab -text [mc "Output file:"] - entry $top.fname -width 60 + ${NS}::button $top.rev -text [mc "Reverse"] -command mkpatchrev + grid $top.rev x -pady 10 -padx 5 + ${NS}::label $top.flab -text [mc "Output file:"] + ${NS}::entry $top.fname -width 60 $top.fname insert 0 [file normalize "patch$patchnum.patch"] incr patchnum grid $top.flab $top.fname -sticky w - frame $top.buts - button $top.buts.gen -text [mc "Generate"] -command mkpatchgo - button $top.buts.can -text [mc "Cancel"] -command mkpatchcan + ${NS}::frame $top.buts + ${NS}::button $top.buts.gen -text [mc "Generate"] -command mkpatchgo + ${NS}::button $top.buts.can -text [mc "Cancel"] -command mkpatchcan + bind $top <Key-Return> mkpatchgo + bind $top <Key-Escape> mkpatchcan grid $top.buts.gen $top.buts.can grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a @@ -7328,7 +8845,7 @@ proc mkpatchgo {} { set cmd [lrange $cmd 1 end] lappend cmd >$fname & if {[catch {eval exec $cmd} err]} { - error_popup "[mc "Error creating patch:"] $err" + error_popup "[mc "Error creating patch:"] $err" $patchtop } catch {destroy $patchtop} unset patchtop @@ -7342,29 +8859,37 @@ proc mkpatchcan {} { } proc mktag {} { - global rowmenuid mktagtop commitinfo + global rowmenuid mktagtop commitinfo NS set top .maketag set mktagtop $top catch {destroy $top} - toplevel $top - label $top.title -text [mc "Create tag"] + ttk_toplevel $top + make_transient $top . + ${NS}::label $top.title -text [mc "Create tag"] grid $top.title - -pady 10 - label $top.id -text [mc "ID:"] - entry $top.sha1 -width 40 -relief flat + ${NS}::label $top.id -text [mc "ID:"] + ${NS}::entry $top.sha1 -width 40 $top.sha1 insert 0 $rowmenuid $top.sha1 conf -state readonly grid $top.id $top.sha1 -sticky w - entry $top.head -width 60 -relief flat + ${NS}::entry $top.head -width 60 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] $top.head conf -state readonly grid x $top.head -sticky w - label $top.tlab -text [mc "Tag name:"] - entry $top.tag -width 60 + ${NS}::label $top.tlab -text [mc "Tag name:"] + ${NS}::entry $top.tag -width 60 grid $top.tlab $top.tag -sticky w - frame $top.buts - button $top.buts.gen -text [mc "Create"] -command mktaggo - button $top.buts.can -text [mc "Cancel"] -command mktagcan + ${NS}::label $top.op -text [mc "Tag message is optional"] + grid $top.op -columnspan 2 -sticky we + ${NS}::label $top.mlab -text [mc "Tag message:"] + ${NS}::entry $top.msg -width 60 + grid $top.mlab $top.msg -sticky w + ${NS}::frame $top.buts + ${NS}::button $top.buts.gen -text [mc "Create"] -command mktaggo + ${NS}::button $top.buts.can -text [mc "Cancel"] -command mktagcan + bind $top <Key-Return> mktaggo + bind $top <Key-Escape> mktagcan grid $top.buts.gen $top.buts.can grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a @@ -7377,19 +8902,24 @@ proc domktag {} { set id [$mktagtop.sha1 get] set tag [$mktagtop.tag get] + set msg [$mktagtop.msg get] if {$tag == {}} { - error_popup [mc "No tag name specified"] - return + error_popup [mc "No tag name specified"] $mktagtop + return 0 } if {[info exists tagids($tag)]} { - error_popup [mc "Tag \"%s\" already exists" $tag] - return + error_popup [mc "Tag \"%s\" already exists" $tag] $mktagtop + return 0 } if {[catch { - exec git tag $tag $id + if {$msg != {}} { + exec git tag -a -m $msg $tag $id + } else { + exec git tag $tag $id + } } err]} { - error_popup "[mc "Error creating tag:"] $err" - return + error_popup "[mc "Error creating tag:"] $err" $mktagtop + return 0 } set tagids($tag) $id @@ -7398,10 +8928,11 @@ proc domktag {} { addedtag $id dispneartags 0 run refill_reflist + return 1 } proc redrawtags {id} { - global canv linehtag idpos currentid curview cmitlisted + global canv linehtag idpos currentid curview cmitlisted markedid global canvxmax iddrawn circleitem mainheadid circlecolors if {![commitinview $id $curview]} return @@ -7415,16 +8946,19 @@ proc redrawtags {id} { $canv itemconf $circleitem($row) -fill $ofill $canv delete tag.$id set xt [eval drawtags $id $idpos($id)] - $canv coords $linehtag($row) $xt [lindex $idpos($id) 2] - set text [$canv itemcget $linehtag($row) -text] - set font [$canv itemcget $linehtag($row) -font] + $canv coords $linehtag($id) $xt [lindex $idpos($id) 2] + set text [$canv itemcget $linehtag($id) -text] + set font [$canv itemcget $linehtag($id) -font] set xr [expr {$xt + [font measure $font $text]}] if {$xr > $canvxmax} { set canvxmax $xr setcanvscroll } if {[info exists currentid] && $currentid == $id} { - make_secsel $row + make_secsel $id + } + if {[info exists markedid] && $markedid eq $id} { + make_idmark $id } } @@ -7436,38 +8970,41 @@ proc mktagcan {} { } proc mktaggo {} { - domktag + if {![domktag]} return mktagcan } proc writecommit {} { - global rowmenuid wrcomtop commitinfo wrcomcmd + global rowmenuid wrcomtop commitinfo wrcomcmd NS set top .writecommit set wrcomtop $top catch {destroy $top} - toplevel $top - label $top.title -text [mc "Write commit to file"] + ttk_toplevel $top + make_transient $top . + ${NS}::label $top.title -text [mc "Write commit to file"] grid $top.title - -pady 10 - label $top.id -text [mc "ID:"] - entry $top.sha1 -width 40 -relief flat + ${NS}::label $top.id -text [mc "ID:"] + ${NS}::entry $top.sha1 -width 40 $top.sha1 insert 0 $rowmenuid $top.sha1 conf -state readonly grid $top.id $top.sha1 -sticky w - entry $top.head -width 60 -relief flat + ${NS}::entry $top.head -width 60 $top.head insert 0 [lindex $commitinfo($rowmenuid) 0] $top.head conf -state readonly grid x $top.head -sticky w - label $top.clab -text [mc "Command:"] - entry $top.cmd -width 60 -textvariable wrcomcmd + ${NS}::label $top.clab -text [mc "Command:"] + ${NS}::entry $top.cmd -width 60 -textvariable wrcomcmd grid $top.clab $top.cmd -sticky w -pady 10 - label $top.flab -text [mc "Output file:"] - entry $top.fname -width 60 + ${NS}::label $top.flab -text [mc "Output file:"] + ${NS}::entry $top.fname -width 60 $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"] grid $top.flab $top.fname -sticky w - frame $top.buts - button $top.buts.gen -text [mc "Write"] -command wrcomgo - button $top.buts.can -text [mc "Cancel"] -command wrcomcan + ${NS}::frame $top.buts + ${NS}::button $top.buts.gen -text [mc "Write"] -command wrcomgo + ${NS}::button $top.buts.can -text [mc "Cancel"] -command wrcomcan + bind $top <Key-Return> wrcomgo + bind $top <Key-Escape> wrcomcan grid $top.buts.gen $top.buts.can grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a @@ -7482,7 +9019,7 @@ proc wrcomgo {} { set cmd "echo $id | [$wrcomtop.cmd get]" set fname [$wrcomtop.fname get] if {[catch {exec sh -c $cmd >$fname &} err]} { - error_popup "[mc "Error writing commit:"] $err" + error_popup "[mc "Error writing commit:"] $err" $wrcomtop } catch {destroy $wrcomtop} unset wrcomtop @@ -7496,24 +9033,27 @@ proc wrcomcan {} { } proc mkbranch {} { - global rowmenuid mkbrtop + global rowmenuid mkbrtop NS set top .makebranch catch {destroy $top} - toplevel $top - label $top.title -text [mc "Create new branch"] + ttk_toplevel $top + make_transient $top . + ${NS}::label $top.title -text [mc "Create new branch"] grid $top.title - -pady 10 - label $top.id -text [mc "ID:"] - entry $top.sha1 -width 40 -relief flat + ${NS}::label $top.id -text [mc "ID:"] + ${NS}::entry $top.sha1 -width 40 $top.sha1 insert 0 $rowmenuid $top.sha1 conf -state readonly grid $top.id $top.sha1 -sticky w - label $top.nlab -text [mc "Name:"] - entry $top.name -width 40 + ${NS}::label $top.nlab -text [mc "Name:"] + ${NS}::entry $top.name -width 40 grid $top.nlab $top.name -sticky w - frame $top.buts - button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top] - button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}" + ${NS}::frame $top.buts + ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top] + ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}" + bind $top <Key-Return> [list mkbrgo $top] + bind $top <Key-Escape> "catch {destroy $top}" grid $top.buts.go $top.buts.can grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a @@ -7526,32 +9066,77 @@ proc mkbrgo {top} { set name [$top.name get] set id [$top.sha1 get] + set cmdargs {} + set old_id {} if {$name eq {}} { - error_popup [mc "Please specify a name for the new branch"] + error_popup [mc "Please specify a name for the new branch"] $top return } + if {[info exists headids($name)]} { + if {![confirm_popup [mc \ + "Branch '%s' already exists. Overwrite?" $name] $top]} { + return + } + set old_id $headids($name) + lappend cmdargs -f + } catch {destroy $top} + lappend cmdargs $name $id nowbusy newbranch update if {[catch { - exec git branch $name $id + eval exec git branch $cmdargs } err]} { notbusy newbranch error_popup $err } else { - set headids($name) $id - lappend idheads($id) $name - addedhead $id $name notbusy newbranch - redrawtags $id + if {$old_id ne {}} { + movehead $id $name + movedhead $id $name + redrawtags $old_id + redrawtags $id + } else { + set headids($name) $id + lappend idheads($id) $name + addedhead $id $name + redrawtags $id + } dispneartags 0 run refill_reflist } } +proc exec_citool {tool_args {baseid {}}} { + global commitinfo env + + set save_env [array get env GIT_AUTHOR_*] + + if {$baseid ne {}} { + if {![info exists commitinfo($baseid)]} { + getcommit $baseid + } + set author [lindex $commitinfo($baseid) 1] + set date [lindex $commitinfo($baseid) 2] + if {[regexp {^\s*(\S.*\S|\S)\s*<(.*)>\s*$} \ + $author author name email] + && $date ne {}} { + set env(GIT_AUTHOR_NAME) $name + set env(GIT_AUTHOR_EMAIL) $email + set env(GIT_AUTHOR_DATE) $date + } + } + + eval exec git citool $tool_args & + + array unset env GIT_AUTHOR_* + array set env $save_env +} + proc cherrypick {} { global rowmenuid curview global mainhead mainheadid + global gitdir set oldhead [exec git rev-parse HEAD] set dheads [descheads $rowmenuid] @@ -7567,7 +9152,26 @@ proc cherrypick {} { # no error occurs, and exec takes that as an indication of error... if {[catch {exec sh -c "git cherry-pick -r $rowmenuid 2>&1"} err]} { notbusy cherrypick - error_popup $err + if {[regexp -line \ + {Entry '(.*)' (would be overwritten by merge|not uptodate)} \ + $err msg fname]} { + error_popup [mc "Cherry-pick failed because of local changes\ + to file '%s'.\nPlease commit, reset or stash\ + your changes and try again." $fname] + } elseif {[regexp -line \ + {^(CONFLICT \(.*\):|Automatic cherry-pick failed|error: could not apply)} \ + $err]} { + if {[confirm_popup [mc "Cherry-pick failed because of merge\ + conflict.\nDo you wish to run git citool to\ + resolve it?"]]} { + # Force citool to read MERGE_MSG + file delete [file join $gitdir "GITGUI_MSG"] + exec_citool {} $rowmenuid + } + } else { + error_popup $err + } + run updatecommits return } set newhead [exec git rev-parse HEAD] @@ -7578,6 +9182,7 @@ proc cherrypick {} { } addnewchild $newhead $oldhead if {[commitinview $oldhead $curview]} { + # XXX this isn't right if we have a path limit... insertrow $newhead $oldhead $curview if {$mainhead ne {}} { movehead $newhead $mainhead @@ -7592,34 +9197,32 @@ proc cherrypick {} { } proc resethead {} { - global mainhead rowmenuid confirm_ok resettype + global mainhead rowmenuid confirm_ok resettype NS set confirm_ok 0 set w ".confirmreset" - toplevel $w - wm transient $w . + ttk_toplevel $w + make_transient $w . wm title $w [mc "Confirm reset"] - message $w.m -text \ - [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] \ - -justify center -aspect 1000 + ${NS}::label $w.m -text \ + [mc "Reset branch %s to %s?" $mainhead [string range $rowmenuid 0 7]] pack $w.m -side top -fill x -padx 20 -pady 20 - frame $w.f -relief sunken -border 2 - message $w.f.rt -text [mc "Reset type:"] -aspect 1000 - grid $w.f.rt -sticky w + ${NS}::labelframe $w.f -text [mc "Reset type:"] set resettype mixed - radiobutton $w.f.soft -value soft -variable resettype -justify left \ + ${NS}::radiobutton $w.f.soft -value soft -variable resettype \ -text [mc "Soft: Leave working tree and index untouched"] grid $w.f.soft -sticky w - radiobutton $w.f.mixed -value mixed -variable resettype -justify left \ + ${NS}::radiobutton $w.f.mixed -value mixed -variable resettype \ -text [mc "Mixed: Leave working tree untouched, reset index"] grid $w.f.mixed -sticky w - radiobutton $w.f.hard -value hard -variable resettype -justify left \ + ${NS}::radiobutton $w.f.hard -value hard -variable resettype \ -text [mc "Hard: Reset working tree and index\n(discard ALL local changes)"] grid $w.f.hard -sticky w - pack $w.f -side top -fill x - button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w" + pack $w.f -side top -fill x -padx 4 + ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w" pack $w.ok -side left -fill x -padx 20 -pady 20 - button $w.cancel -text [mc Cancel] -command "destroy $w" + ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w" + bind $w <Key-Escape> [list destroy $w] pack $w.cancel -side right -fill x -padx 20 -pady 20 bind $w <Visibility> "grab $w; focus $w" tkwait window $w @@ -7674,6 +9277,9 @@ proc headmenu {x y id head} { set headmenuid $id set headmenuhead $head set state normal + if {[string match "remotes/*" $head]} { + set state disabled + } if {$head eq $mainhead} { set state disabled } @@ -7684,7 +9290,7 @@ proc headmenu {x y id head} { proc cobranch {} { global headmenuid headmenuhead headids - global showlocalchanges mainheadid + global showlocalchanges # check the tree is clean first?? nowbusy checkout [mc "Checking out"] @@ -7705,6 +9311,7 @@ proc cobranch {} { proc readcheckoutstat {fd newhead newheadid} { global mainhead mainheadid headids showlocalchanges progresscoords + global viewmainheadid curview if {[gets $fd line] >= 0} { if {[regexp {([0-9]+)% \(([0-9]+)/([0-9]+)\)} $line match p m n]} { @@ -7722,6 +9329,7 @@ proc readcheckoutstat {fd newhead newheadid} { set oldmainid $mainheadid set mainhead $newhead set mainheadid $newheadid + set viewmainheadid($curview) $newheadid redrawtags $oldmainid redrawtags $newheadid selbyid $newheadid @@ -7764,7 +9372,7 @@ proc rmbranch {} { # Display a list of tags and heads proc showrefs {} { - global showrefstop bgcolor fgcolor selectbgcolor + global showrefstop bgcolor fgcolor selectbgcolor NS global bglist fglist reflistfilter reflist maincursor set top .showrefs @@ -7774,8 +9382,9 @@ proc showrefs {} { refill_reflist return } - toplevel $top + ttk_toplevel $top wm title $top [mc "Tags and heads: %s" [file tail [pwd]]] + make_transient $top . text $top.list -background $bgcolor -foreground $fgcolor \ -selectbackground $selectbgcolor -font mainfont \ -xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \ @@ -7784,19 +9393,20 @@ proc showrefs {} { $top.list tag configure highlight -background $selectbgcolor lappend bglist $top.list lappend fglist $top.list - scrollbar $top.ysb -command "$top.list yview" -orient vertical - scrollbar $top.xsb -command "$top.list xview" -orient horizontal + ${NS}::scrollbar $top.ysb -command "$top.list yview" -orient vertical + ${NS}::scrollbar $top.xsb -command "$top.list xview" -orient horizontal grid $top.list $top.ysb -sticky nsew grid $top.xsb x -sticky ew - frame $top.f - label $top.f.l -text "[mc "Filter"]: " - entry $top.f.e -width 20 -textvariable reflistfilter + ${NS}::frame $top.f + ${NS}::label $top.f.l -text "[mc "Filter"]: " + ${NS}::entry $top.f.e -width 20 -textvariable reflistfilter set reflistfilter "*" trace add variable reflistfilter write reflistfilter_change pack $top.f.e -side right -fill x -expand 1 pack $top.f.l -side left grid $top.f - -sticky ew -pady 2 - button $top.close -command [list destroy $top] -text [mc "Close"] + ${NS}::button $top.close -command [list destroy $top] -text [mc "Close"] + bind $top <Key-Escape> [list destroy $top] grid $top.close - grid columnconfigure $top 0 -weight 1 grid rowconfigure $top 0 -weight 1 @@ -7838,7 +9448,7 @@ proc reflistfilter_change {n1 n2 op} { proc refill_reflist {} { global reflist reflistfilter showrefstop headids tagids otherrefids - global curview commitinterest + global curview if {![info exists showrefstop] || ![winfo exists $showrefstop]} return set refs {} @@ -7847,7 +9457,7 @@ proc refill_reflist {} { if {[commitinview $headids($n) $curview]} { lappend refs [list $n H] } else { - set commitinterest($headids($n)) {run refill_reflist} + interestedin $headids($n) {run refill_reflist} } } } @@ -7856,7 +9466,7 @@ proc refill_reflist {} { if {[commitinview $tagids($n) $curview]} { lappend refs [list $n T] } else { - set commitinterest($tagids($n)) {run refill_reflist} + interestedin $tagids($n) {run refill_reflist} } } } @@ -7865,7 +9475,7 @@ proc refill_reflist {} { if {[commitinview $otherrefids($n) $curview]} { lappend refs [list $n o] } else { - set commitinterest($otherrefids($n)) {run refill_reflist} + interestedin $otherrefids($n) {run refill_reflist} } } } @@ -7921,6 +9531,7 @@ proc refill_reflist {} { proc getallcommits {} { global allcommits nextarc seeds allccache allcwait cachedarcs allcupdate global idheads idtags idotherrefs allparents tagobjid + global gitdir if {![info exists allcommits]} { set nextarc 0 @@ -7928,7 +9539,7 @@ proc getallcommits {} { set seeds {} set allcwait 0 set cachedarcs 0 - set allccache [file join [gitdir] "gitk.cache"] + set allccache [file join $gitdir "gitk.cache"] if {![catch { set f [open $allccache r] set allcwait 1 @@ -7993,7 +9604,7 @@ proc getallclines {fd} { global allparents allchildren idtags idheads nextarc global arcnos arcids arctags arcout arcend arcstart archeads growing global seeds allcommits cachedarcs allcupdate - + set nid 0 while {[incr nid] <= 1000 && [gets $fd line] >= 0} { set id [lindex $line 0] @@ -9055,7 +10666,7 @@ proc showtag {tag isnew} { global ctext tagcontents tagids linknum tagobjid if {$isnew} { - addtohistory [list showtag $tag 0] + addtohistory [list showtag $tag 0] savectextpos } $ctext conf -state normal clear_ctext @@ -9063,7 +10674,7 @@ proc showtag {tag isnew} { set linknum 0 if {![info exists tagcontents($tag)]} { catch { - set tagcontents($tag) [exec git cat-file tag $tagobjid($tag)] + set tagcontents($tag) [exec git cat-file tag $tag] } } if {[info exists tagcontents($tag)]} { @@ -9072,6 +10683,7 @@ proc showtag {tag isnew} { set text "[mc "Tag"]: $tag\n[mc "Id"]: $tagids($tag)" } appendwithlinks $text {} + maybe_scroll_ctext 1 $ctext conf -state disabled init_flist {} } @@ -9090,18 +10702,19 @@ proc doquit {} { } proc mkfontdisp {font top which} { - global fontattr fontpref $font + global fontattr fontpref $font NS use_ttk set fontpref($font) [set $font] - button $top.${font}but -text $which -font optionfont \ + ${NS}::button $top.${font}but -text $which \ -command [list choosefont $font $which] - label $top.$font -relief flat -font $font \ + ${NS}::label $top.$font -relief flat -font $font \ -text $fontattr($font,family) -justify left grid x $top.${font}but $top.$font -sticky w } proc choosefont {font which} { global fontparam fontlist fonttop fontattr + global prefstop NS set fontparam(which) $which set fontparam(font) $font @@ -9114,20 +10727,21 @@ proc choosefont {font which} { if {![winfo exists $top]} { font create sample eval font config sample [font actual $font] - toplevel $top + ttk_toplevel $top + make_transient $top $prefstop wm title $top [mc "Gitk font chooser"] - label $top.l -textvariable fontparam(which) + ${NS}::label $top.l -textvariable fontparam(which) pack $top.l -side top set fontlist [lsort [font families]] - frame $top.f + ${NS}::frame $top.f listbox $top.f.fam -listvariable fontlist \ -yscrollcommand [list $top.f.sb set] bind $top.f.fam <<ListboxSelect>> selfontfam - scrollbar $top.f.sb -command [list $top.f.fam yview] + ${NS}::scrollbar $top.f.sb -command [list $top.f.fam yview] pack $top.f.sb -side right -fill y pack $top.f.fam -side left -fill both -expand 1 pack $top.f -side top -fill both -expand 1 - frame $top.g + ${NS}::frame $top.g spinbox $top.g.size -from 4 -to 40 -width 4 \ -textvariable fontparam(size) \ -validatecommand {string is integer -strict %s} @@ -9145,9 +10759,11 @@ proc choosefont {font which} { -fill black -tags text bind $top.c <Configure> [list centertext $top.c] pack $top.c -side top -fill x - frame $top.buts - button $top.buts.ok -text [mc "OK"] -command fontok -default active - button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal + ${NS}::frame $top.buts + ${NS}::button $top.buts.ok -text [mc "OK"] -command fontok -default active + ${NS}::button $top.buts.can -text [mc "Cancel"] -command fontcan -default normal + bind $top <Key-Return> fontok + bind $top <Key-Escape> fontcan grid $top.buts.ok $top.buts.can grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a @@ -9179,9 +10795,9 @@ proc fontok {} { if {$fontparam(slant) eq "italic"} { lappend fontpref($f) "italic" } - set w $prefstop.$f + set w $prefstop.notebook.fonts.$f $w conf -text $fontparam(family) -font $fontpref($f) - + fontcan } @@ -9196,6 +10812,28 @@ proc fontcan {} { } } +if {[package vsatisfies [package provide Tk] 8.6]} { + # In Tk 8.6 we have a native font chooser dialog. Overwrite the above + # function to make use of it. + proc choosefont {font which} { + tk fontchooser configure -title $which -font $font \ + -command [list on_choosefont $font $which] + tk fontchooser show + } + proc on_choosefont {font which newfont} { + global fontparam + puts stderr "$font $newfont" + array set f [font actual $newfont] + set fontparam(which) $which + set fontparam(font) $font + set fontparam(family) $f(-family) + set fontparam(size) $f(-size) + set fontparam(weight) $f(-weight) + set fontparam(slant) $f(-slant) + fontok + } +} + proc selfontfam {} { global fonttop fontparam @@ -9211,11 +10849,145 @@ proc chg_fontparam {v sub op} { font config sample -$sub $fontparam($sub) } +# Create a property sheet tab page +proc create_prefs_page {w} { + global NS + set parent [join [lrange [split $w .] 0 end-1] .] + if {[winfo class $parent] eq "TNotebook"} { + ${NS}::frame $w + } else { + ${NS}::labelframe $w + } +} + +proc prefspage_general {notebook} { + global NS maxwidth maxgraphpct showneartags showlocalchanges + global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs + global hideremotes want_ttk have_ttk + + set page [create_prefs_page $notebook.general] + + ${NS}::label $page.ldisp -text [mc "Commit list display options"] + grid $page.ldisp - -sticky w -pady 10 + ${NS}::label $page.spacer -text " " + ${NS}::label $page.maxwidthl -text [mc "Maximum graph width (lines)"] + spinbox $page.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth + grid $page.spacer $page.maxwidthl $page.maxwidth -sticky w + ${NS}::label $page.maxpctl -text [mc "Maximum graph width (% of pane)"] + spinbox $page.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct + grid x $page.maxpctl $page.maxpct -sticky w + ${NS}::checkbutton $page.showlocal -text [mc "Show local changes"] \ + -variable showlocalchanges + grid x $page.showlocal -sticky w + ${NS}::checkbutton $page.autoselect -text [mc "Auto-select SHA1 (length)"] \ + -variable autoselect + spinbox $page.autosellen -from 1 -to 40 -width 4 -textvariable autosellen + grid x $page.autoselect $page.autosellen -sticky w + ${NS}::checkbutton $page.hideremotes -text [mc "Hide remote refs"] \ + -variable hideremotes + grid x $page.hideremotes -sticky w + + ${NS}::label $page.ddisp -text [mc "Diff display options"] + grid $page.ddisp - -sticky w -pady 10 + ${NS}::label $page.tabstopl -text [mc "Tab spacing"] + spinbox $page.tabstop -from 1 -to 20 -width 4 -textvariable tabstop + grid x $page.tabstopl $page.tabstop -sticky w + ${NS}::checkbutton $page.ntag -text [mc "Display nearby tags"] \ + -variable showneartags + grid x $page.ntag -sticky w + ${NS}::checkbutton $page.ldiff -text [mc "Limit diffs to listed paths"] \ + -variable limitdiffs + grid x $page.ldiff -sticky w + ${NS}::checkbutton $page.lattr -text [mc "Support per-file encodings"] \ + -variable perfile_attrs + grid x $page.lattr -sticky w + + ${NS}::entry $page.extdifft -textvariable extdifftool + ${NS}::frame $page.extdifff + ${NS}::label $page.extdifff.l -text [mc "External diff tool" ] + ${NS}::button $page.extdifff.b -text [mc "Choose..."] -command choose_extdiff + pack $page.extdifff.l $page.extdifff.b -side left + pack configure $page.extdifff.l -padx 10 + grid x $page.extdifff $page.extdifft -sticky ew + + ${NS}::label $page.lgen -text [mc "General options"] + grid $page.lgen - -sticky w -pady 10 + ${NS}::checkbutton $page.want_ttk -variable want_ttk \ + -text [mc "Use themed widgets"] + if {$have_ttk} { + ${NS}::label $page.ttk_note -text [mc "(change requires restart)"] + } else { + ${NS}::label $page.ttk_note -text [mc "(currently unavailable)"] + } + grid x $page.want_ttk $page.ttk_note -sticky w + return $page +} + +proc prefspage_colors {notebook} { + global NS uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor + + set page [create_prefs_page $notebook.colors] + + ${NS}::label $page.cdisp -text [mc "Colors: press to choose"] + grid $page.cdisp - -sticky w -pady 10 + label $page.ui -padx 40 -relief sunk -background $uicolor + ${NS}::button $page.uibut -text [mc "Interface"] \ + -command [list choosecolor uicolor {} $page.ui [mc "interface"] setui] + grid x $page.uibut $page.ui -sticky w + label $page.bg -padx 40 -relief sunk -background $bgcolor + ${NS}::button $page.bgbut -text [mc "Background"] \ + -command [list choosecolor bgcolor {} $page.bg [mc "background"] setbg] + grid x $page.bgbut $page.bg -sticky w + label $page.fg -padx 40 -relief sunk -background $fgcolor + ${NS}::button $page.fgbut -text [mc "Foreground"] \ + -command [list choosecolor fgcolor {} $page.fg [mc "foreground"] setfg] + grid x $page.fgbut $page.fg -sticky w + label $page.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0] + ${NS}::button $page.diffoldbut -text [mc "Diff: old lines"] \ + -command [list choosecolor diffcolors 0 $page.diffold [mc "diff old lines"] \ + [list $ctext tag conf d0 -foreground]] + grid x $page.diffoldbut $page.diffold -sticky w + label $page.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1] + ${NS}::button $page.diffnewbut -text [mc "Diff: new lines"] \ + -command [list choosecolor diffcolors 1 $page.diffnew [mc "diff new lines"] \ + [list $ctext tag conf dresult -foreground]] + grid x $page.diffnewbut $page.diffnew -sticky w + label $page.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2] + ${NS}::button $page.hunksepbut -text [mc "Diff: hunk header"] \ + -command [list choosecolor diffcolors 2 $page.hunksep \ + [mc "diff hunk header"] \ + [list $ctext tag conf hunksep -foreground]] + grid x $page.hunksepbut $page.hunksep -sticky w + label $page.markbgsep -padx 40 -relief sunk -background $markbgcolor + ${NS}::button $page.markbgbut -text [mc "Marked line bg"] \ + -command [list choosecolor markbgcolor {} $page.markbgsep \ + [mc "marked line background"] \ + [list $ctext tag conf omark -background]] + grid x $page.markbgbut $page.markbgsep -sticky w + label $page.selbgsep -padx 40 -relief sunk -background $selectbgcolor + ${NS}::button $page.selbgbut -text [mc "Select bg"] \ + -command [list choosecolor selectbgcolor {} $page.selbgsep [mc "background"] setselbg] + grid x $page.selbgbut $page.selbgsep -sticky w + return $page +} + +proc prefspage_fonts {notebook} { + global NS + set page [create_prefs_page $notebook.fonts] + ${NS}::label $page.cfont -text [mc "Fonts: press to choose"] + grid $page.cfont - -sticky w -pady 10 + mkfontdisp mainfont $page [mc "Main font"] + mkfontdisp textfont $page [mc "Diff display font"] + mkfontdisp uifont $page [mc "User interface font"] + return $page +} + proc doprefs {} { - global maxwidth maxgraphpct + global maxwidth maxgraphpct use_ttk NS global oldprefs prefstop showneartags showlocalchanges - global bgcolor fgcolor ctext diffcolors selectbgcolor - global tabstop limitdiffs autoselect extdifftool + global uicolor bgcolor fgcolor ctext diffcolors selectbgcolor markbgcolor + global tabstop limitdiffs autoselect autosellen extdifftool perfile_attrs + global hideremotes want_ttk have_ttk set top .gitkprefs set prefstop $top @@ -9224,109 +10996,62 @@ proc doprefs {} { return } foreach v {maxwidth maxgraphpct showneartags showlocalchanges \ - limitdiffs tabstop} { + limitdiffs tabstop perfile_attrs hideremotes want_ttk} { set oldprefs($v) [set $v] } - toplevel $top + ttk_toplevel $top wm title $top [mc "Gitk preferences"] - label $top.ldisp -text [mc "Commit list display options"] - grid $top.ldisp - -sticky w -pady 10 - label $top.spacer -text " " - label $top.maxwidthl -text [mc "Maximum graph width (lines)"] \ - -font optionfont - spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth - grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w - label $top.maxpctl -text [mc "Maximum graph width (% of pane)"] \ - -font optionfont - spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct - grid x $top.maxpctl $top.maxpct -sticky w - frame $top.showlocal - label $top.showlocal.l -text [mc "Show local changes"] -font optionfont - checkbutton $top.showlocal.b -variable showlocalchanges - pack $top.showlocal.b $top.showlocal.l -side left - grid x $top.showlocal -sticky w - frame $top.autoselect - label $top.autoselect.l -text [mc "Auto-select SHA1"] -font optionfont - checkbutton $top.autoselect.b -variable autoselect - pack $top.autoselect.b $top.autoselect.l -side left - grid x $top.autoselect -sticky w - - label $top.ddisp -text [mc "Diff display options"] - grid $top.ddisp - -sticky w -pady 10 - label $top.tabstopl -text [mc "Tab spacing"] -font optionfont - spinbox $top.tabstop -from 1 -to 20 -width 4 -textvariable tabstop - grid x $top.tabstopl $top.tabstop -sticky w - frame $top.ntag - label $top.ntag.l -text [mc "Display nearby tags"] -font optionfont - checkbutton $top.ntag.b -variable showneartags - pack $top.ntag.b $top.ntag.l -side left - grid x $top.ntag -sticky w - frame $top.ldiff - label $top.ldiff.l -text [mc "Limit diffs to listed paths"] -font optionfont - checkbutton $top.ldiff.b -variable limitdiffs - pack $top.ldiff.b $top.ldiff.l -side left - grid x $top.ldiff -sticky w - - entry $top.extdifft -textvariable extdifftool - frame $top.extdifff - label $top.extdifff.l -text [mc "External diff tool" ] -font optionfont \ - -padx 10 - button $top.extdifff.b -text [mc "Choose..."] -font optionfont \ - -command choose_extdiff - pack $top.extdifff.l $top.extdifff.b -side left - grid x $top.extdifff $top.extdifft -sticky w - - label $top.cdisp -text [mc "Colors: press to choose"] - grid $top.cdisp - -sticky w -pady 10 - label $top.bg -padx 40 -relief sunk -background $bgcolor - button $top.bgbut -text [mc "Background"] -font optionfont \ - -command [list choosecolor bgcolor {} $top.bg background setbg] - grid x $top.bgbut $top.bg -sticky w - label $top.fg -padx 40 -relief sunk -background $fgcolor - button $top.fgbut -text [mc "Foreground"] -font optionfont \ - -command [list choosecolor fgcolor {} $top.fg foreground setfg] - grid x $top.fgbut $top.fg -sticky w - label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0] - button $top.diffoldbut -text [mc "Diff: old lines"] -font optionfont \ - -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \ - [list $ctext tag conf d0 -foreground]] - grid x $top.diffoldbut $top.diffold -sticky w - label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1] - button $top.diffnewbut -text [mc "Diff: new lines"] -font optionfont \ - -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \ - [list $ctext tag conf d1 -foreground]] - grid x $top.diffnewbut $top.diffnew -sticky w - label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2] - button $top.hunksepbut -text [mc "Diff: hunk header"] -font optionfont \ - -command [list choosecolor diffcolors 2 $top.hunksep \ - "diff hunk header" \ - [list $ctext tag conf hunksep -foreground]] - grid x $top.hunksepbut $top.hunksep -sticky w - label $top.selbgsep -padx 40 -relief sunk -background $selectbgcolor - button $top.selbgbut -text [mc "Select bg"] -font optionfont \ - -command [list choosecolor selectbgcolor {} $top.selbgsep background setselbg] - grid x $top.selbgbut $top.selbgsep -sticky w - - label $top.cfont -text [mc "Fonts: press to choose"] - grid $top.cfont - -sticky w -pady 10 - mkfontdisp mainfont $top [mc "Main font"] - mkfontdisp textfont $top [mc "Diff display font"] - mkfontdisp uifont $top [mc "User interface font"] - - frame $top.buts - button $top.buts.ok -text [mc "OK"] -command prefsok -default active - button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal + make_transient $top . + + if {[set use_notebook [expr {$use_ttk && [info command ::ttk::notebook] ne ""}]]} { + set notebook [ttk::notebook $top.notebook] + } else { + set notebook [${NS}::frame $top.notebook -borderwidth 0 -relief flat] + } + + lappend pages [prefspage_general $notebook] [mc "General"] + lappend pages [prefspage_colors $notebook] [mc "Colors"] + lappend pages [prefspage_fonts $notebook] [mc "Fonts"] + set col 0 + foreach {page title} $pages { + if {$use_notebook} { + $notebook add $page -text $title + } else { + set btn [${NS}::button $notebook.b_[string map {. X} $page] \ + -text $title -command [list raise $page]] + $page configure -text $title + grid $btn -row 0 -column [incr col] -sticky w + grid $page -row 1 -column 0 -sticky news -columnspan 100 + } + } + + if {!$use_notebook} { + grid columnconfigure $notebook 0 -weight 1 + grid rowconfigure $notebook 1 -weight 1 + raise [lindex $pages 0] + } + + grid $notebook -sticky news -padx 2 -pady 2 + grid rowconfigure $top 0 -weight 1 + grid columnconfigure $top 0 -weight 1 + + ${NS}::frame $top.buts + ${NS}::button $top.buts.ok -text [mc "OK"] -command prefsok -default active + ${NS}::button $top.buts.can -text [mc "Cancel"] -command prefscan -default normal + bind $top <Key-Return> prefsok + bind $top <Key-Escape> prefscan grid $top.buts.ok $top.buts.can grid columnconfigure $top.buts 0 -weight 1 -uniform a grid columnconfigure $top.buts 1 -weight 1 -uniform a grid $top.buts - - -pady 10 -sticky ew - bind $top <Visibility> "focus $top.buts.ok" + grid columnconfigure $top 2 -weight 1 + bind $top <Visibility> [list focus $top.buts.ok] } proc choose_extdiff {} { global extdifftool - set prog [tk_getOpenFile -title "External diff tool" -multiple false] + set prog [tk_getOpenFile -title [mc "External diff tool"] -multiple false] if {$prog ne {}} { set extdifftool $prog } @@ -9353,6 +11078,21 @@ proc setselbg {c} { allcanvs itemconf secsel -fill $c } +# This sets the background color and the color scheme for the whole UI. +# For some reason, tk_setPalette chooses a nasty dark red for selectColor +# if we don't specify one ourselves, which makes the checkbuttons and +# radiobuttons look bad. This chooses white for selectColor if the +# background color is light, or black if it is dark. +proc setui {c} { + if {[tk windowingsystem] eq "win32"} { return } + set bg [winfo rgb . $c] + set selc black + if {[lindex $bg 0] + 1.5 * [lindex $bg 1] + 0.5 * [lindex $bg 2] > 100000} { + set selc white + } + tk_setPalette background $c selectColor $selc +} + proc setbg {c} { global bglist @@ -9369,13 +11109,14 @@ proc setfg {c} { } allcanvs itemconf text -fill $c $canv itemconf circle -outline $c + $canv itemconf markid -outline $c } proc prefscan {} { global oldprefs prefstop foreach v {maxwidth maxgraphpct showneartags showlocalchanges \ - limitdiffs tabstop} { + limitdiffs tabstop perfile_attrs hideremotes want_ttk} { global $v set $v $oldprefs($v) } @@ -9388,7 +11129,8 @@ proc prefsok {} { global maxwidth maxgraphpct global oldprefs prefstop showneartags showlocalchanges global fontpref mainfont textfont uifont - global limitdiffs treediffs + global limitdiffs treediffs perfile_attrs + global hideremotes catch {destroy $prefstop} unset prefstop @@ -9421,8 +11163,10 @@ proc prefsok {} { dohidelocalchanges } } - if {$limitdiffs != $oldprefs(limitdiffs)} { - # treediffs elements are limited by path + if {$limitdiffs != $oldprefs(limitdiffs) || + ($perfile_attrs && !$oldprefs(perfile_attrs))} { + # treediffs elements are limited by path; + # won't have encodings cached if perfile_attrs was just turned on catch {unset treediffs} } if {$fontchanged || $maxwidth != $oldprefs(maxwidth) @@ -9432,12 +11176,15 @@ proc prefsok {} { $limitdiffs != $oldprefs(limitdiffs)} { reselectline } + if {$hideremotes != $oldprefs(hideremotes)} { + rereadrefs + } } proc formatdate {d} { global datetimeformat if {$d ne {}} { - set d [clock format $d -format $datetimeformat] + set d [clock format [lindex $d 0] -format $datetimeformat] } return $d } @@ -9646,7 +11393,7 @@ set encoding_aliases { { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 } { GBK CP936 MS936 windows-936 } { JIS_Encoding csJISEncoding } - { Shift_JIS MS_Kanji csShiftJIS } + { Shift_JIS MS_Kanji csShiftJIS ShiftJIS Shift-JIS } { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese EUC-JP } { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese } @@ -9681,14 +11428,17 @@ set encoding_aliases { } proc tcl_encoding {enc} { - global encoding_aliases + global encoding_aliases tcl_encoding_cache + if {[info exists tcl_encoding_cache($enc)]} { + return $tcl_encoding_cache($enc) + } set names [encoding names] set lcnames [string tolower $names] set enc [string tolower $enc] set i [lsearch -exact $lcnames $enc] if {$i < 0} { # look for "isonnn" instead of "iso-nnn" or "iso_nnn" - if {[regsub {^iso[-_]} $enc iso encx]} { + if {[regsub {^(iso|cp|ibm|jis)[-_]} $enc {\1} encx]} { set i [lsearch -exact $lcnames $encx] } } @@ -9700,7 +11450,7 @@ proc tcl_encoding {enc} { foreach e $ll { set i [lsearch -exact $lcnames $e] if {$i < 0} { - if {[regsub {^iso[-_]} $e iso ex]} { + if {[regsub {^(iso|cp|ibm|jis)[-_]} $e {\1} ex]} { set i [lsearch -exact $lcnames $ex] } } @@ -9709,16 +11459,76 @@ proc tcl_encoding {enc} { break } } + set tclenc {} if {$i >= 0} { - return [lindex $names $i] + set tclenc [lindex $names $i] } - return {} + set tcl_encoding_cache($enc) $tclenc + return $tclenc +} + +proc gitattr {path attr default} { + global path_attr_cache + if {[info exists path_attr_cache($attr,$path)]} { + set r $path_attr_cache($attr,$path) + } else { + set r "unspecified" + if {![catch {set line [exec git check-attr $attr -- $path]}]} { + regexp "(.*): $attr: (.*)" $line m f r + } + set path_attr_cache($attr,$path) $r + } + if {$r eq "unspecified"} { + return $default + } + return $r +} + +proc cache_gitattr {attr pathlist} { + global path_attr_cache + set newlist {} + foreach path $pathlist { + if {![info exists path_attr_cache($attr,$path)]} { + lappend newlist $path + } + } + set lim 1000 + if {[tk windowingsystem] == "win32"} { + # windows has a 32k limit on the arguments to a command... + set lim 30 + } + while {$newlist ne {}} { + set head [lrange $newlist 0 [expr {$lim - 1}]] + set newlist [lrange $newlist $lim end] + if {![catch {set rlist [eval exec git check-attr $attr -- $head]}]} { + foreach row [split $rlist "\n"] { + if {[regexp "(.*): $attr: (.*)" $row m path value]} { + if {[string index $path 0] eq "\""} { + set path [encoding convertfrom [lindex $path 0]] + } + set path_attr_cache($attr,$path) $value + } + } + } + } +} + +proc get_path_encoding {path} { + global gui_encoding perfile_attrs + set tcl_enc $gui_encoding + if {$path ne {} && $perfile_attrs} { + set enc2 [tcl_encoding [gitattr $path encoding $tcl_enc]] + if {$enc2 ne {}} { + set tcl_enc $enc2 + } + } + return $tcl_enc } # First check that Tcl/Tk is recent enough if {[catch {package require Tk 8.4} err]} { - show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\ - Gitk requires at least Tcl/Tk 8.4."] + show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\ + Gitk requires at least Tcl/Tk 8.4." list exit 1 } @@ -9729,6 +11539,9 @@ set gitencoding {} catch { set gitencoding [exec git config --get i18n.commitencoding] } +catch { + set gitencoding [exec git config --get i18n.logoutputencoding] +} if {$gitencoding == ""} { set gitencoding "utf-8" } @@ -9737,9 +11550,38 @@ if {$tclencoding == {}} { puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk" } -set mainfont {Helvetica 9} -set textfont {Courier 9} -set uifont {Helvetica 9 bold} +set gui_encoding [encoding system] +catch { + set enc [exec git config --get gui.encoding] + if {$enc ne {}} { + set tclenc [tcl_encoding $enc] + if {$tclenc ne {}} { + set gui_encoding $tclenc + } else { + puts stderr "Warning: encoding $enc is not supported by Tcl/Tk" + } + } +} + +set log_showroot true +catch { + set log_showroot [exec git config --bool --get log.showroot] +} + +if {[tk windowingsystem] eq "aqua"} { + set mainfont {{Lucida Grande} 9} + set textfont {Monaco 9} + set uifont {{Lucida Grande} 9 bold} +} elseif {![catch {::tk::pkgconfig get fontsystem} xft] && $xft eq "xft"} { + # fontconfig! + set mainfont {sans 9} + set textfont {monospace 9} + set uifont {sans 9 bold} +} else { + set mainfont {Helvetica 9} + set textfont {Courier 9} + set uifont {Helvetica 9 bold} +} set tabstop 8 set findmergefiles 0 set maxgraphpct 50 @@ -9752,25 +11594,50 @@ set mingaplen 100 set cmitmode "patch" set wrapcomment "none" set showneartags 1 +set hideremotes 0 set maxrefs 20 set maxlinelen 200 set showlocalchanges 1 set limitdiffs 1 set datetimeformat "%Y-%m-%d %H:%M:%S" set autoselect 1 +set autosellen 40 +set perfile_attrs 0 +set want_ttk 1 -set extdifftool "meld" +if {[tk windowingsystem] eq "aqua"} { + set extdifftool "opendiff" +} else { + set extdifftool "meld" +} set colors {green red blue magenta darkgrey brown orange} -set bgcolor white -set fgcolor black +if {[tk windowingsystem] eq "win32"} { + set uicolor SystemButtonFace + set bgcolor SystemWindow + set fgcolor SystemButtonText + set selectbgcolor SystemHighlight +} else { + set uicolor grey85 + set bgcolor white + set fgcolor black + set selectbgcolor gray85 +} set diffcolors {red "#00a000" blue} set diffcontext 3 set ignorespace 0 -set selectbgcolor gray85 +set worddiff "" +set markbgcolor "#e0e0ff" set circlecolors {white blue gray blue blue} +# button for popping up context menus +if {[tk windowingsystem] eq "aqua"} { + set ctxbut <Button-2> +} else { + set ctxbut <Button-3> +} + ## For msgcat loading, first locate the installation location. if { [info exists ::env(GITK_MSGSDIR)] } { ## Msgsdir was manually set in the environment. @@ -9792,8 +11659,6 @@ namespace import ::msgcat::mc catch {source ~/.gitk} -font create optionfont -family sans-serif -size -12 - parsefont mainfont $mainfont eval font create mainfont [fontflags mainfont] eval font create mainfontbold [fontflags mainfont 1] @@ -9805,17 +11670,18 @@ eval font create textfontbold [fontflags textfont 1] parsefont uifont $uifont eval font create uifont [fontflags uifont] +setui $uicolor + setoptions # check that we can find a .git directory somewhere... -if {[catch {set gitdir [gitdir]}]} { +if {[catch {set gitdir [exec git rev-parse --git-dir]}]} { show_error {} . [mc "Cannot find a git repository here."] exit 1 } -if {![file isdirectory $gitdir]} { - show_error {} . [mc "Cannot find the git directory \"%s\"." $gitdir] - exit 1 -} + +set selecthead {} +set selectheadid {} set revtreeargs {} set cmdline_files {} @@ -9828,6 +11694,9 @@ foreach arg $argv { set cmdline_files [lrange $argv [expr {$i + 1}] end] break } + "--select-commit=*" { + set selecthead [string range $arg 16 end] + } "--argscmd=*" { set revtreeargscmd [string range $arg 10 end] } @@ -9838,6 +11707,10 @@ foreach arg $argv { incr i } +if {$selecthead eq "HEAD"} { + set selecthead {} +} + if {$i >= [llength $argv] && $revtreeargs ne {}} { # no -- on command line, but some arguments (other than --argscmd) if {[catch { @@ -9872,6 +11745,20 @@ set nullid2 "0000000000000000000000000000000000000001" set nullfile "/dev/null" set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}] +if {![info exists have_ttk]} { + set have_ttk [llength [info commands ::ttk::style]] +} +set use_ttk [expr {$have_ttk && $want_ttk}] +set NS [expr {$use_ttk ? "ttk" : ""}] + +regexp {^git version ([\d.]*\d)} [exec git version] _ git_version + +set show_notes {} +if {[package vcompare $git_version "1.6.6.2"] >= 0} { + set show_notes "--show-notes" +} + +set appname "gitk" set runq {} set history {} @@ -9881,8 +11768,8 @@ set nhl_names {} set highlight_paths {} set findpattern {} set searchdirn -forwards -set boldrows {} -set boldnamerows {} +set boldids {} +set boldnameids {} set diffelide {0 0} set markingmatches 0 set linkentercount 0 @@ -9909,12 +11796,41 @@ set stopped 0 set stuffsaved 0 set patchnum 0 set lserial 0 -set isworktree [expr {[exec git rev-parse --is-inside-work-tree] == "true"}] +set hasworktree [hasworktree] +set cdup {} +if {[expr {[exec git rev-parse --is-inside-work-tree] == "true"}]} { + set cdup [exec git rev-parse --show-cdup] +} +set worktree [exec git rev-parse --show-toplevel] setcoords makewindow +catch { + image create photo gitlogo -width 16 -height 16 + + image create photo gitlogominus -width 4 -height 2 + gitlogominus put #C00000 -to 0 0 4 2 + gitlogo copy gitlogominus -to 1 5 + gitlogo copy gitlogominus -to 6 5 + gitlogo copy gitlogominus -to 11 5 + image delete gitlogominus + + image create photo gitlogoplus -width 4 -height 4 + gitlogoplus put #008000 -to 1 0 3 4 + gitlogoplus put #008000 -to 0 1 4 3 + gitlogo copy gitlogoplus -to 1 9 + gitlogo copy gitlogoplus -to 6 9 + gitlogo copy gitlogoplus -to 11 9 + image delete gitlogoplus + + image create photo gitlogo32 -width 32 -height 32 + gitlogo32 copy gitlogo -zoom 2 2 + + wm iconphoto . -default gitlogo gitlogo32 +} # wait for the window to become visible tkwait visibility . -wm title . "[file tail $argv0]: [file tail [pwd]]" +wm title . "$appname: [reponame]" +update readrefs if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} { @@ -9929,8 +11845,8 @@ if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} { set viewperm(1) 0 set vdatemode(1) 0 addviewmenu 1 - .bar.view entryconf [mc "Edit view..."] -state normal - .bar.view entryconf [mc "Delete view"] -state normal + .bar.view entryconf [mca "Edit view..."] -state normal + .bar.view entryconf [mca "Delete view"] -state normal } if {[info exists permviews]} { @@ -9945,4 +11861,15 @@ if {[info exists permviews]} { addviewmenu $n } } -getcommits + +if {[tk windowingsystem] eq "win32"} { + focus -force . +} + +getcommits {} + +# Local variables: +# mode: tcl +# indent-tabs-mode: t +# tab-width: 8 +# End: |