diff options
Diffstat (limited to 'gitk-git/gitk')
-rwxr-xr-x | gitk-git/gitk | 602 |
1 files changed, 441 insertions, 161 deletions
diff --git a/gitk-git/gitk b/gitk-git/gitk index 78358a712a..a14d7a16b2 100755 --- a/gitk-git/gitk +++ b/gitk-git/gitk @@ -2,7 +2,7 @@ # Tcl ignores the next line -*- tcl -*- \ exec wish "$0" -- "$@" -# Copyright © 2005-2014 Paul Mackerras. All rights reserved. +# Copyright © 2005-2016 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. @@ -588,7 +588,7 @@ proc updatecommits {} { proc reloadcommits {} { global curview viewcomplete selectedline currentid thickerline global showneartags treediffs commitinterest cached_commitrow - global targetid + global targetid commitinfo set selid {} if {$selectedline ne {}} { @@ -600,18 +600,19 @@ proc reloadcommits {} { } resetvarcs $curview set selectedline {} - catch {unset currentid} - catch {unset thickerline} - catch {unset treediffs} + unset -nocomplain currentid + unset -nocomplain thickerline + unset -nocomplain treediffs readrefs changedrefs if {$showneartags} { getallcommits } clear_display - catch {unset commitinterest} - catch {unset cached_commitrow} - catch {unset targetid} + unset -nocomplain commitinfo + unset -nocomplain commitinterest + unset -nocomplain cached_commitrow + unset -nocomplain targetid setcanvscroll getcommits $selid return 0 @@ -673,7 +674,7 @@ proc resetvarcs {view} { foreach vd [array names vseedcount $view,*] { unset vseedcount($vd) } - catch {unset ordertok} + unset -nocomplain ordertok } # returns a list of the commits with no children @@ -966,7 +967,7 @@ proc insertrow {id p v} { set vp $v,$p if {[llength [lappend children($vp) $id]] > 1} { set children($vp) [lsort -command [list vtokcmp $v] $children($vp)] - catch {unset ordertok} + unset -nocomplain ordertok } fix_reversal $p $a $v incr commitidx($v) @@ -1136,7 +1137,7 @@ proc update_arcrows {v} { set displayorder [lrange $displayorder 0 [expr {$vrowmod($v) - 1}]] set parentlist [lrange $parentlist 0 [expr {$vrowmod($v) - 1}]] } - catch {unset cached_commitrow} + unset -nocomplain cached_commitrow } set narctot [expr {[llength $varctok($v)] - 1}] set a $varcmod($v) @@ -1315,7 +1316,7 @@ proc commitonrow {row} { proc closevarcs {v} { global varctok varccommits varcid parents children - global cmitlisted commitidx vtokmod + global cmitlisted commitidx vtokmod curview numcommits set missing_parents 0 set scripts {} @@ -1340,6 +1341,9 @@ proc closevarcs {v} { } lappend varccommits($v,$b) $p incr commitidx($v) + if {$v == $curview} { + set numcommits $commitidx($v) + } set scripts [check_interest $p $scripts] } } @@ -1442,7 +1446,7 @@ proc getcommitlines {fd inst view updating} { if {[string range $err 0 4] == "usage"} { set err "Gitk: error reading commits$fv:\ bad arguments to git log." - if {$viewname($view) eq "Command line"} { + if {$viewname($view) eq [mc "Command line"]} { append err \ " (Note: arguments to gitk are passed to git log\ to allow selection of commits to be displayed.)" @@ -1579,7 +1583,7 @@ proc getcommitlines {fd inst view updating} { [vtokcmp $view [lindex $children($vp) end-1] $id] > 0} { set children($vp) [lsort -command [list vtokcmp $view] \ $children($vp)] - catch {unset ordertok} + unset -nocomplain ordertok } if {[info exists varcid($view,$p)]} { fix_reversal $p $a $view @@ -1778,7 +1782,7 @@ proc readrefs {} { global hideremotes foreach v {tagids idtags headids idheads otherrefids idotherrefs} { - catch {unset $v} + unset -nocomplain $v } set refd [open [list | git show-ref -d] r] while {[gets $refd line] >= 0} { @@ -1894,13 +1898,13 @@ proc make_transient {window origin} { } } -proc show_error {w top msg {mc mc}} { +proc show_error {w top msg} { global NS if {![info exists NS]} {set NS ""} if {[wm state $top] eq "withdrawn"} { wm deiconify $top } message $w.m -text $msg -justify center -aspect 400 pack $w.m -side top -fill x -padx 20 -pady 20 - ${NS}::button $w.ok -default active -text [$mc OK] -command "destroy $top" + ${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" @@ -1943,6 +1947,8 @@ proc confirm_popup {msg {owner .}} { } proc setoptions {} { + global use_ttk + if {[tk windowingsystem] ne "win32"} { option add *Panedwindow.showHandle 1 startupFile option add *Panedwindow.sashRelief raised startupFile @@ -1965,6 +1971,18 @@ proc setoptions {} { option add *Listbox.font mainfont startupFile } +proc setttkstyle {} { + eval font configure TkDefaultFont [fontflags mainfont] + eval font configure TkTextFont [fontflags textfont] + eval font configure TkHeadingFont [fontflags mainfont] + eval font configure TkCaptionFont [fontflags mainfont] -weight bold + eval font configure TkTooltipFont [fontflags uifont] + eval font configure TkFixedFont [fontflags textfont] + eval font configure TkIconFont [fontflags uifont] + eval font configure TkMenuFont [fontflags uifont] + eval font configure TkSmallCaptionFont [fontflags uifont] +} + # 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...} @@ -2065,33 +2083,33 @@ proc makewindow {} { # The "mc" arguments here are purely so that xgettext # sees the following string as needing to be translated set file { - mc "File" cascade { - {mc "Update" command updatecommits -accelerator F5} - {mc "Reload" command reloadcommits -accelerator Shift-F5} - {mc "Reread references" command rereadrefs} - {mc "List references" command showrefs -accelerator F2} + mc "&File" cascade { + {mc "&Update" command updatecommits -accelerator F5} + {mc "&Reload" command reloadcommits -accelerator Shift-F5} + {mc "Reread re&ferences" command rereadrefs} + {mc "&List references" command showrefs -accelerator F2} {xx "" separator} - {mc "Start git gui" command {exec git gui &}} + {mc "Start git &gui" command {exec git gui &}} {xx "" separator} - {mc "Quit" command doquit -accelerator Meta1-Q} + {mc "&Quit" command doquit -accelerator Meta1-Q} }} set edit { - mc "Edit" cascade { - {mc "Preferences" command doprefs} + mc "&Edit" cascade { + {mc "&Preferences" command doprefs} }} set view { - mc "View" cascade { - {mc "New view..." command {newview 0} -accelerator Shift-F4} - {mc "Edit view..." command editview -state disabled -accelerator F4} - {mc "Delete view" command delview -state disabled} + mc "&View" cascade { + {mc "&New view..." command {newview 0} -accelerator Shift-F4} + {mc "&Edit view..." command editview -state disabled -accelerator F4} + {mc "&Delete view" command delview -state disabled} {xx "" separator} - {mc "All files" radiobutton {selectedview 0} -command {showview 0}} + {mc "&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} + mc "&Help" cascade { + {mc "&About gitk" command about} + {mc "&Key bindings" command keys} }} set bar [list $file $edit $view $help] } else { @@ -2099,13 +2117,13 @@ proc makewindow {} { 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 "&Apple" cascade { + {mc "&About gitk" command about} {xx "" separator} }} set help { - mc "Help" cascade { - {mc "Key bindings" command keys} + mc "&Help" cascade { + {mc "&Key bindings" command keys} }} set bar [list $apple $file $view $help] } @@ -2251,7 +2269,7 @@ proc makewindow {} { 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 progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"] set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow] set rprogitem [$progresscanv create rect -1 0 0 $h -fill red] } @@ -2347,6 +2365,9 @@ proc makewindow {} { ${NS}::frame .bleft.mid ${NS}::frame .bleft.bottom + # gap between sub-widgets + set wgap [font measure uifont "i"] + ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch pack .bleft.top.search -side left -padx 5 set sstring .bleft.top.sstring @@ -2361,8 +2382,9 @@ proc makewindow {} { -command changediffdisp -variable diffelide -value {0 1} ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \ -command changediffdisp -variable diffelide -value {1 0} + ${NS}::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: " - pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left + pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap spinbox .bleft.mid.diffcontext -width 5 \ -from 0 -increment 1 -to 10000000 \ -validate all -validatecommand "diffcontextvalidate %P" \ @@ -2370,7 +2392,7 @@ proc makewindow {} { .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 + pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \ -command changeignorespace -variable ignorespace pack .bleft.mid.ignspace -side left -padx 5 @@ -2385,7 +2407,7 @@ proc makewindow {} { set ctext .bleft.bottom.ctext text $ctext -background $bgcolor -foreground $fgcolor \ - -state disabled -font textfont \ + -state disabled -undo 0 -font textfont \ -yscrollcommand scrolltext -wrap none \ -xscrollcommand ".bleft.bottom.sbhorizontal set" if {$have_tk85} { @@ -2516,6 +2538,13 @@ proc makewindow {} { } else { bindall <ButtonRelease-4> "allcanvs yview scroll -5 units" bindall <ButtonRelease-5> "allcanvs yview scroll 5 units" + bind $ctext <Button> { + if {"%b" eq 6} { + $ctext xview scroll -5 units + } elseif {"%b" eq 7} { + $ctext xview scroll 5 units + } + } if {[tk windowingsystem] eq "aqua"} { bindall <MouseWheel> { set delta [expr {- (%D)}] @@ -2561,6 +2590,7 @@ proc makewindow {} { bindkey b prevfile bindkey d "$ctext yview scroll 18 units" bindkey u "$ctext yview scroll -18 units" + bindkey g {$sha1entry delete 0 end; focus $sha1entry} bindkey / {focus $fstring} bindkey <Key-KP_Divide> {focus $fstring} bindkey <Key-Return> {dofind 1 1} @@ -2610,6 +2640,7 @@ proc makewindow {} { {mc "Diff selected -> this" command {diffvssel 1}} {mc "Make patch" command mkpatch} {mc "Create tag" command mktag} + {mc "Copy commit summary" command copysummary} {mc "Write commit to file" command writecommit} {mc "Create new branch" command mkbranch} {mc "Cherry-pick this commit" command cherrypick} @@ -2637,7 +2668,9 @@ proc makewindow {} { set headctxmenu .headctxmenu makemenu $headctxmenu { {mc "Check out this branch" command cobranch} + {mc "Rename this branch" command mvbranch} {mc "Remove this branch" command rmbranch} + {mc "Copy branch name" command {clipboard clear; clipboard append $headmenuhead}} } $headctxmenu configure -tearoff 0 @@ -2648,6 +2681,7 @@ proc makewindow {} { {mc "Highlight this only" command {flist_hl 1}} {mc "External diff" command {external_diff}} {mc "Blame parent commit" command {external_blame 1}} + {mc "Copy path" command {clipboard clear; clipboard append $flist_menu_file}} } $flist_menu configure -tearoff 0 @@ -2776,33 +2810,87 @@ proc doprogupdate {} { } } +proc config_check_tmp_exists {tries_left} { + global config_file_tmp + + if {[file exists $config_file_tmp]} { + incr tries_left -1 + if {$tries_left > 0} { + after 100 [list config_check_tmp_exists $tries_left] + } else { + error_popup "There appears to be a stale $config_file_tmp\ + file, which will prevent gitk from saving its configuration on exit.\ + Please remove it if it is not being used by any existing gitk process." + } + } +} + +proc config_init_trace {name} { + global config_variable_changed config_variable_original + + upvar #0 $name var + set config_variable_changed($name) 0 + set config_variable_original($name) $var +} + +proc config_variable_change_cb {name name2 op} { + global config_variable_changed config_variable_original + + upvar #0 $name var + if {$op eq "write" && + (![info exists config_variable_original($name)] || + $config_variable_original($name) ne $var)} { + set config_variable_changed($name) 1 + } +} + proc savestuff {w} { - global viewname viewfiles viewargs viewargscmd viewperm nextviewnum - global use_ttk global stuffsaved global config_file config_file_tmp - global config_variables + global config_variables config_variable_changed + global viewchanged + + upvar #0 viewname current_viewname + upvar #0 viewfiles current_viewfiles + upvar #0 viewargs current_viewargs + upvar #0 viewargscmd current_viewargscmd + upvar #0 viewperm current_viewperm + upvar #0 nextviewnum current_nextviewnum + upvar #0 use_ttk current_use_ttk if {$stuffsaved} return if {![winfo viewable .]} return - catch { - if {[file exists $config_file_tmp]} { - file delete -force $config_file_tmp + set remove_tmp 0 + if {[catch { + set try_count 0 + while {[catch {set f [open $config_file_tmp {WRONLY CREAT EXCL}]}]} { + if {[incr try_count] > 50} { + error "Unable to write config file: $config_file_tmp exists" + } + after 100 } - set f [open $config_file_tmp w] + set remove_tmp 1 if {$::tcl_platform(platform) eq {windows}} { file attributes $config_file_tmp -hidden true } + if {[file exists $config_file]} { + source $config_file + } foreach var_name $config_variables { upvar #0 $var_name var - puts $f [list set $var_name $var] + upvar 0 $var_name old_var + if {!$config_variable_changed($var_name) && [info exists old_var]} { + puts $f [list set $var_name $old_var] + } else { + puts $f [list set $var_name $var] + } } puts $f "set geometry(main) [wm geometry .]" puts $f "set geometry(state) [wm state .]" puts $f "set geometry(topwidth) [winfo width .tf]" puts $f "set geometry(topheight) [winfo height .tf]" - if {$use_ttk} { + if {$current_use_ttk} { puts $f "set geometry(pwsash0) \"[.tf.histframe.pwclist sashpos 0] 1\"" puts $f "set geometry(pwsash1) \"[.tf.histframe.pwclist sashpos 1] 1\"" } else { @@ -2812,15 +2900,43 @@ proc savestuff {w} { puts $f "set geometry(botwidth) [winfo width .bleft]" puts $f "set geometry(botheight) [winfo height .bleft]" + array set view_save {} + array set views {} + if {![info exists permviews]} { set permviews {} } + foreach view $permviews { + set view_save([lindex $view 0]) 1 + set views([lindex $view 0]) $view + } puts -nonewline $f "set permviews {" - for {set v 0} {$v < $nextviewnum} {incr v} { - if {$viewperm($v)} { - puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v) $viewargscmd($v)]}" + for {set v 1} {$v < $current_nextviewnum} {incr v} { + if {$viewchanged($v)} { + if {$current_viewperm($v)} { + set views($current_viewname($v)) [list $current_viewname($v) $current_viewfiles($v) $current_viewargs($v) $current_viewargscmd($v)] + } else { + set view_save($current_viewname($v)) 0 + } + } + } + # write old and updated view to their places and append remaining to the end + foreach view $permviews { + set view_name [lindex $view 0] + if {$view_save($view_name)} { + puts $f "{$views($view_name)}" } + unset views($view_name) + } + foreach view_name [array names views] { + puts $f "{$views($view_name)}" } puts $f "}" close $f file rename -force $config_file_tmp $config_file + set remove_tmp 0 + } err]} { + puts "Error saving config: $err" + } + if {$remove_tmp} { + file delete -force $config_file_tmp } set stuffsaved 1 } @@ -2910,7 +3026,7 @@ proc bindall {event action} { } proc about {} { - global uifont NS + global bgcolor NS set w .about if {[winfo exists $w]} { raise $w @@ -2922,10 +3038,10 @@ proc about {} { message $w.m -text [mc " Gitk - a commit viewer for git -Copyright \u00a9 2005-2014 Paul Mackerras +Copyright \u00a9 2005-2016 Paul Mackerras Use and redistribute under the terms of the GNU General Public License"] \ - -justify center -aspect 400 -border 2 -bg white -relief groove + -justify center -aspect 400 -border 2 -bg $bgcolor -relief groove pack $w.m -side top -fill x -padx 2 -pady 2 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active pack $w.ok -side bottom @@ -2936,7 +3052,7 @@ Use and redistribute under the terms of the GNU General Public License"] \ } proc keys {} { - global NS + global bgcolor NS set w .keys if {[winfo exists $w]} { raise $w @@ -2980,6 +3096,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 "g Go to commit"] [mc "/ Focus the search box"] [mc "? Move to previous find hit"] [mc "f Scroll diff view to next file"] @@ -2991,7 +3108,7 @@ proc keys {} { [mc "<%s-minus> Decrease font size" $M1T] [mc "<F5> Update"] " \ - -justify left -bg white -border 2 -relief groove + -justify left -bg $bgcolor -border 2 -relief groove pack $w.m -side top -fill both -padx 2 -pady 2 ${NS}::button $w.ok -text [mc "Close"] -command "destroy $w" -default active bind $w <Key-Escape> [list destroy $w] @@ -3285,7 +3402,7 @@ set rectmask { 0x00, 0x00, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0xfc, 0x0f, 0x00, 0x00}; } -image create bitmap reficon-H -background black -foreground green \ +image create bitmap reficon-H -background black -foreground "#00ff00" \ -data $rectdata -maskdata $rectmask image create bitmap reficon-o -background black -foreground "#ddddff" \ -data $rectdata -maskdata $rectmask @@ -3300,7 +3417,7 @@ proc init_flist {first} { set cflist_top 1 $cflist tag add highlight 1.0 "1.0 lineend" } else { - catch {unset cflist_top} + unset -nocomplain cflist_top } $cflist conf -state disabled set difffilestart {} @@ -3945,6 +4062,19 @@ proc shellsplit {str} { return $l } +proc set_window_title {} { + global appname curview viewname vrevs + set rev [mc "All files"] + if {$curview ne 0} { + if {$viewname($curview) eq [mc "Command line"]} { + set rev [string map {"--gitk-symmetric-diff-marker" "--merge"} $vrevs($curview)] + } else { + set rev $viewname($curview) + } + } + wm title . "[reponame]: $rev - $appname" +} + # Code to implement multiple views proc newview {ishighlight} { @@ -3977,6 +4107,7 @@ set known_view_options { {committer t15 . "--committer=*" {mc "Committer:"}} {loginfo t15 .. "--grep=*" {mc "Commit Message:"}} {allmatch b .. "--all-match" {mc "Matches all Commit Info criteria"}} + {igrep b .. "--invert-grep" {mc "Matches no Commit Info criteria"}} {changes_l l + {} {mc "Changes to Files:"}} {pickaxe_s r0 . {} {mc "Fixed String"}} {pickaxe_t r1 . "--pickaxe-regex" {mc "Regular Expression"}} @@ -4238,7 +4369,7 @@ proc allviewmenus {n op args} { proc newviewok {top n {apply 0}} { global nextviewnum newviewperm newviewname newishighlight - global viewname viewfiles viewperm selectedview curview + global viewname viewfiles viewperm viewchanged selectedview curview global viewargs viewargscmd newviewopts viewhlmenu if {[catch { @@ -4259,6 +4390,7 @@ proc newviewok {top n {apply 0}} { incr nextviewnum set viewname($n) $newviewname($n) set viewperm($n) $newviewopts($n,perm) + set viewchanged($n) 1 set viewfiles($n) $files set viewargs($n) $newargs set viewargscmd($n) $newviewopts($n,cmd) @@ -4271,6 +4403,7 @@ proc newviewok {top n {apply 0}} { } else { # editing an existing view set viewperm($n) $newviewopts($n,perm) + set viewchanged($n) 1 if {$newviewname($n) ne $viewname($n)} { set viewname($n) $newviewname($n) doviewmenu .bar.view 5 [list showview $n] \ @@ -4293,7 +4426,7 @@ proc newviewok {top n {apply 0}} { } proc delview {} { - global curview viewperm hlview selectedhlview + global curview viewperm hlview selectedhlview viewchanged if {$curview == 0} return if {[info exists hlview] && $hlview == $curview} { @@ -4302,6 +4435,7 @@ proc delview {} { } allviewmenus $curview delete set viewperm($curview) 0 + set viewchanged($curview) 1 showview 0 } @@ -4345,20 +4479,20 @@ proc showview {n} { } unselectline normalline - catch {unset treediffs} + unset -nocomplain treediffs clear_display if {[info exists hlview] && $hlview == $n} { unset hlview set selectedhlview [mc "None"] } - catch {unset commitinterest} - catch {unset cached_commitrow} - catch {unset ordertok} + unset -nocomplain commitinterest + unset -nocomplain cached_commitrow + unset -nocomplain ordertok set curview $n set selectedview $n - .bar.view entryconf [mca "Edit view..."] -state [expr {$n == 0? "disabled": "normal"}] - .bar.view entryconf [mca "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)]} { @@ -4373,8 +4507,8 @@ proc showview {n} { set rowfinal {} set numcommits $commitidx($n) - catch {unset colormap} - catch {unset rowtextx} + unset -nocomplain colormap + unset -nocomplain rowtextx set nextcolor 0 set canvxmax [$canv cget -width] set curview $n @@ -4417,6 +4551,7 @@ proc showview {n} { } elseif {$numcommits == 0} { show_status [mc "No commits selected"] } + set_window_title } # Stuff relating to the highlighting facility @@ -4508,7 +4643,7 @@ proc delvhighlight {} { if {![info exists hlview]} return unset hlview - catch {unset vhighlights} + unset -nocomplain vhighlights unbolden } @@ -4556,7 +4691,7 @@ proc hfiles_change {} { # delete previous highlights catch {close $filehighlight} unset filehighlight - catch {unset fhighlights} + unset -nocomplain fhighlights unbolden unhighlight_filelist } @@ -4617,7 +4752,7 @@ proc findcom_change args { bolden_name $id mainfont } set boldnameids {} - catch {unset nhighlights} + unset -nocomplain nhighlights unbolden unmarkmatches if {$gdttype ne [mc "containing:"] || $findstring eq {}} { @@ -4820,9 +4955,9 @@ proc rhighlight_sel {a} { global descendent desc_todo ancestor anc_todo global highlight_related - catch {unset descendent} + unset -nocomplain descendent set desc_todo [list $a] - catch {unset ancestor} + unset -nocomplain ancestor set anc_todo [list $a] if {$highlight_related ne [mc "None"]} { rhighlight_none @@ -4833,7 +4968,7 @@ proc rhighlight_sel {a} { proc rhighlight_none {} { global rhighlights - catch {unset rhighlights} + unset -nocomplain rhighlights unbolden } @@ -5041,8 +5176,8 @@ proc initlayout {} { set rowisopt {} set rowfinal {} set canvxmax [$canv cget -width] - catch {unset colormap} - catch {unset rowtextx} + unset -nocomplain colormap + unset -nocomplain rowtextx setcanvscroll } @@ -6275,17 +6410,17 @@ proc clear_display {} { global linehtag linentag linedtag boldids boldnameids allcanvs delete all - catch {unset iddrawn} - catch {unset linesegs} - catch {unset linehtag} - catch {unset linentag} - catch {unset linedtag} + unset -nocomplain iddrawn + unset -nocomplain linesegs + unset -nocomplain linehtag + unset -nocomplain linentag + unset -nocomplain linedtag set boldids {} set boldnameids {} - catch {unset vhighlights} - catch {unset fhighlights} - catch {unset nhighlights} - catch {unset rhighlights} + unset -nocomplain vhighlights + unset -nocomplain fhighlights + unset -nocomplain nhighlights + unset -nocomplain rhighlights set need_redisplay 0 set nrows_drawn 0 } @@ -6557,6 +6692,7 @@ proc show_status {msg} { global canv fgcolor clear_display + set_window_title $canv create text 3 3 -anchor nw -text $msg -font mainfont \ -tags text -fill $fgcolor } @@ -7133,7 +7269,7 @@ proc selectline {l isnew {desired_loc {}} {switch_to_patch 0}} { global autoselect autosellen jump_to_here global vinlinediff - catch {unset pending_select} + unset -nocomplain pending_select $canv delete hover normalline unsel_reflist @@ -7331,7 +7467,7 @@ proc unselectline {} { global selectedline currentid set selectedline {} - catch {unset currentid} + unset -nocomplain currentid allcanvs delete secsel rhighlight_none } @@ -7387,7 +7523,7 @@ proc unset_posvars {} { if {[info exists last_posvars]} { foreach {var val} $last_posvars { global $var - catch {unset $var} + unset -nocomplain $var } unset last_posvars } @@ -7455,7 +7591,7 @@ proc gettree {id} { global nullid nullid2 set diffids $id - catch {unset diffmergeid} + unset -nocomplain diffmergeid if {![info exists treefilelist($id)]} { if {![info exists treepending]} { if {$id eq $nullid} { @@ -7611,7 +7747,7 @@ proc startdiff {ids} { settabs 1 set diffids $ids - catch {unset diffmergeid} + unset -nocomplain diffmergeid if {![info exists treediffs($ids)] || [lsearch -exact $ids $nullid] >= 0 || [lsearch -exact $ids $nullid2] >= 0} { @@ -7938,7 +8074,11 @@ proc getblobdiffline {bdf ids} { $ctext conf -state normal while {[incr nr] <= 1000 && [gets $bdf line] >= 0} { if {$ids != $diffids || $bdf != $blobdifffd($ids)} { + # Older diff read. Abort it. catch {close $bdf} + if {$ids != $diffids} { + array unset blobdifffd $ids + } return 0 } parseblobdiffline $ids $line @@ -7947,6 +8087,7 @@ proc getblobdiffline {bdf ids} { blobdiffmaybeseehere [eof $bdf] if {[eof $bdf]} { catch {close $bdf} + array unset blobdifffd $ids return 0 } return [expr {$nr >= 1000? 2: 1}] @@ -8232,7 +8373,7 @@ proc clear_ctext {{first 1.0}} { } $ctext delete $first end if {$first eq "1.0"} { - catch {unset pendinglinks} + unset -nocomplain pendinglinks } set ctext_file_names {} set ctext_file_lines {} @@ -8408,7 +8549,7 @@ proc scrolltext {f0 f1} { highlightfile_for_scrollpos $topidx } - catch {unset suppress_highlighting_file_for_this_scrollpos} + unset -nocomplain suppress_highlighting_file_for_this_scrollpos .bleft.bottom.sb set $f0 $f1 if {$searchstring ne {}} { @@ -8783,13 +8924,13 @@ proc rowmenu {x y id} { if {$id ne $nullid && $id ne $nullid2} { set menu $rowctxmenu if {$mainhead ne {}} { - $menu entryconfigure 7 -label [mc "Reset %s branch to here" $mainhead] -state normal + $menu entryconfigure 8 -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 8 -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 + $menu entryconfigure 12 -state $mstate } else { set menu $fakerowmenu } @@ -9248,6 +9389,20 @@ proc mktaggo {} { mktagcan } +proc copysummary {} { + global rowmenuid autosellen + + set format "%h (\"%s\", %ad)" + set cmd [list git show -s --pretty=format:$format --date=short] + if {$autosellen < 40} { + lappend cmd --abbrev=$autosellen + } + set summary [eval exec $cmd $rowmenuid] + + clipboard clear + clipboard append $summary +} + proc writecommit {} { global rowmenuid wrcomtop commitinfo wrcomcmd NS @@ -9307,26 +9462,63 @@ proc wrcomcan {} { } proc mkbranch {} { - global rowmenuid mkbrtop NS + global NS rowmenuid + + set top .branchdialog + + set val(name) "" + set val(id) $rowmenuid + set val(command) [list mkbrgo $top] + + set ui(title) [mc "Create branch"] + set ui(accept) [mc "Create"] + + branchdia $top val ui +} + +proc mvbranch {} { + global NS + global headmenuid headmenuhead + + set top .branchdialog + + set val(name) $headmenuhead + set val(id) $headmenuid + set val(command) [list mvbrgo $top $headmenuhead] + + set ui(title) [mc "Rename branch %s" $headmenuhead] + set ui(accept) [mc "Rename"] + + branchdia $top val ui +} + +proc branchdia {top valvar uivar} { + global NS commitinfo + upvar $valvar val $uivar ui - set top .makebranch catch {destroy $top} ttk_toplevel $top make_transient $top . - ${NS}::label $top.title -text [mc "Create new branch"] + ${NS}::label $top.title -text $ui(title) grid $top.title - -pady 10 ${NS}::label $top.id -text [mc "ID:"] ${NS}::entry $top.sha1 -width 40 - $top.sha1 insert 0 $rowmenuid + $top.sha1 insert 0 $val(id) $top.sha1 conf -state readonly grid $top.id $top.sha1 -sticky w + ${NS}::entry $top.head -width 60 + $top.head insert 0 [lindex $commitinfo($val(id)) 0] + $top.head conf -state readonly + grid x $top.head -sticky ew + grid columnconfigure $top 1 -weight 1 ${NS}::label $top.nlab -text [mc "Name:"] ${NS}::entry $top.name -width 40 + $top.name insert 0 $val(name) grid $top.nlab $top.name -sticky w ${NS}::frame $top.buts - ${NS}::button $top.buts.go -text [mc "Create"] -command [list mkbrgo $top] + ${NS}::button $top.buts.go -text $ui(accept) -command $val(command) ${NS}::button $top.buts.can -text [mc "Cancel"] -command "catch {destroy $top}" - bind $top <Key-Return> [list mkbrgo $top] + bind $top <Key-Return> $val(command) bind $top <Key-Escape> "catch {destroy $top}" grid $top.buts.go $top.buts.can grid columnconfigure $top.buts 0 -weight 1 -uniform a @@ -9381,6 +9573,46 @@ proc mkbrgo {top} { } } +proc mvbrgo {top prevname} { + global headids idheads mainhead mainheadid + + set name [$top.name get] + set id [$top.sha1 get] + set cmdargs {} + if {$name eq $prevname} { + catch {destroy $top} + return + } + if {$name eq {}} { + error_popup [mc "Please specify a new name for the branch"] $top + return + } + catch {destroy $top} + lappend cmdargs -m $prevname $name + nowbusy renamebranch + update + if {[catch { + eval exec git branch $cmdargs + } err]} { + notbusy renamebranch + error_popup $err + } else { + notbusy renamebranch + removehead $id $prevname + removedhead $id $prevname + set headids($name) $id + lappend idheads($id) $name + addedhead $id $name + if {$prevname eq $mainhead} { + set mainhead $name + set mainheadid $id + } + redrawtags $id + dispneartags 0 + run refill_reflist + } +} + proc exec_citool {tool_args {baseid {}}} { global commitinfo env @@ -9606,20 +9838,25 @@ proc readresetstat {fd} { # context menu for a head proc headmenu {x y id head} { - global headmenuid headmenuhead headctxmenu mainhead + global headmenuid headmenuhead headctxmenu mainhead headids stopfinding set headmenuid $id set headmenuhead $head - set state normal + array set state {0 normal 1 normal 2 normal} if {[string match "remotes/*" $head]} { - set state disabled + set localhead [string range $head [expr [string last / $head] + 1] end] + if {[info exists headids($localhead)]} { + set state(0) disabled + } + array set state {1 disabled 2 disabled} } if {$head eq $mainhead} { - set state disabled + array set state {0 disabled 2 disabled} + } + foreach i {0 1 2} { + $headctxmenu entryconfigure $i -state $state($i) } - $headctxmenu entryconfigure 0 -state $state - $headctxmenu entryconfigure 1 -state $state tk_popup $headctxmenu $x $y } @@ -9628,11 +9865,27 @@ proc cobranch {} { global showlocalchanges # check the tree is clean first?? + set newhead $headmenuhead + set command [list | git checkout] + if {[string match "remotes/*" $newhead]} { + set remote $newhead + set newhead [string range $newhead [expr [string last / $newhead] + 1] end] + # The following check is redundant - the menu option should + # be disabled to begin with... + if {[info exists headids($newhead)]} { + error_popup [mc "A local branch named %s exists already" $newhead] + return + } + lappend command -b $newhead --track $remote + } else { + lappend command $newhead + } + lappend command 2>@1 nowbusy checkout [mc "Checking out"] update dohidelocalchanges if {[catch { - set fd [open [list | git checkout $headmenuhead 2>@1] r] + set fd [open $command r] } err]} { notbusy checkout error_popup $err @@ -9640,12 +9893,12 @@ proc cobranch {} { dodiffindex } } else { - filerun $fd [list readcheckoutstat $fd $headmenuhead $headmenuid] + filerun $fd [list readcheckoutstat $fd $newhead $headmenuid] } } proc readcheckoutstat {fd newhead newheadid} { - global mainhead mainheadid headids showlocalchanges progresscoords + global mainhead mainheadid headids idheads showlocalchanges progresscoords global viewmainheadid curview if {[gets $fd line] >= 0} { @@ -9660,8 +9913,14 @@ proc readcheckoutstat {fd newhead newheadid} { notbusy checkout if {[catch {close $fd} err]} { error_popup $err + return } set oldmainid $mainheadid + if {! [info exists headids($newhead)]} { + set headids($newhead) $newheadid + lappend idheads($newheadid) $newhead + addedhead $newheadid $newhead + } set mainhead $newhead set mainheadid $newheadid set viewmainheadid($curview) $newheadid @@ -9726,8 +9985,10 @@ proc showrefs {} { -width 30 -height 20 -cursor $maincursor \ -spacing1 1 -spacing3 1 -state disabled $top.list tag configure highlight -background $selectbgcolor - lappend bglist $top.list - lappend fglist $top.list + if {![lsearch -exact $bglist $top.list]} { + lappend bglist $top.list + lappend fglist $top.list + } ${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 @@ -10010,9 +10271,9 @@ proc getallclines {fd} { } if {$nid > 0} { global cached_dheads cached_dtags cached_atags - catch {unset cached_dheads} - catch {unset cached_dtags} - catch {unset cached_atags} + unset -nocomplain cached_dheads + unset -nocomplain cached_dtags + unset -nocomplain cached_atags } if {![eof $fd]} { return [expr {$nid >= 1000? 2: 1}] @@ -10252,7 +10513,7 @@ proc dropcache {err} { foreach v {arcnos arcout arcids arcstart arcend growing \ arctags archeads allparents allchildren} { global $v - catch {unset $v} + unset -nocomplain $v } set allcwait 0 set nextarc 0 @@ -10903,8 +11164,8 @@ proc addedtag {id} { if {![info exists arcout($id)]} { recalcarc [lindex $arcnos($id) 0] } - catch {unset cached_dtags} - catch {unset cached_atags} + unset -nocomplain cached_dtags + unset -nocomplain cached_atags } proc addedhead {hid head} { @@ -10914,13 +11175,13 @@ proc addedhead {hid head} { if {![info exists arcout($hid)]} { recalcarc [lindex $arcnos($hid) 0] } - catch {unset cached_dheads} + unset -nocomplain cached_dheads } proc removedhead {hid head} { global cached_dheads - catch {unset cached_dheads} + unset -nocomplain cached_dheads } proc movedhead {hid head} { @@ -10930,7 +11191,7 @@ proc movedhead {hid head} { if {![info exists arcout($hid)]} { recalcarc [lindex $arcnos($hid) 0] } - catch {unset cached_dheads} + unset -nocomplain cached_dheads } proc changedrefs {} { @@ -10946,10 +11207,10 @@ proc changedrefs {} { } } } - catch {unset cached_tagcontent} - catch {unset cached_dtags} - catch {unset cached_atags} - catch {unset cached_dheads} + unset -nocomplain cached_tagcontent + unset -nocomplain cached_dtags + unset -nocomplain cached_atags + unset -nocomplain cached_dheads } proc rereadrefs {} { @@ -11237,6 +11498,7 @@ proc prefspage_general {notebook} { ${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 + #xgettext:no-tcl-format ${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 @@ -11438,7 +11700,9 @@ proc choosecolor {v vi w x cmd} { proc setselbg {c} { global bglist cflist foreach w $bglist { - $w configure -selectbackground $c + if {[winfo exists $w]} { + $w configure -selectbackground $c + } } $cflist tag configure highlight \ -background [$cflist cget -selectbackground] @@ -11464,7 +11728,9 @@ proc setbg {c} { global bglist foreach w $bglist { - $w conf -background $c + if {[winfo exists $w]} { + $w conf -background $c + } } } @@ -11472,7 +11738,9 @@ proc setfg {c} { global fglist canv foreach w $fglist { - $w conf -foreground $c + if {[winfo exists $w]} { + $w conf -foreground $c + } } allcanvs itemconf text -fill $c $canv itemconf circle -outline $c @@ -11534,7 +11802,7 @@ proc prefsok {} { ($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} + unset -nocomplain treediffs } if {$fontchanged || $maxwidth != $oldprefs(maxwidth) || $maxgraphpct != $oldprefs(maxgraphpct)} { @@ -11914,10 +12182,29 @@ proc get_path_encoding {path} { return $tcl_enc } +## For msgcat loading, first locate the installation location. +if { [info exists ::env(GITK_MSGSDIR)] } { + ## Msgsdir was manually set in the environment. + set gitk_msgsdir $::env(GITK_MSGSDIR) +} else { + ## Let's guess the prefix from argv0. + set gitk_prefix [file dirname [file dirname [file normalize $argv0]]] + set gitk_libdir [file join $gitk_prefix share gitk lib] + set gitk_msgsdir [file join $gitk_libdir msgs] + unset gitk_prefix +} + +## Internationalization (i18n) through msgcat and gettext. See +## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html +package require msgcat +namespace import ::msgcat::mc +## And eventually load the actual message catalog +::msgcat::mcload $gitk_msgsdir + # First check that Tcl/Tk is recent enough if {[catch {package require Tk 8.4} err]} { - show_error {} . "Sorry, gitk cannot run with this version of Tcl/Tk.\n\ - Gitk requires at least Tcl/Tk 8.4." list + show_error {} . [mc "Sorry, gitk cannot run with this version of Tcl/Tk.\n\ + Gitk requires at least Tcl/Tk 8.4."] exit 1 } @@ -11936,7 +12223,7 @@ if { [info exists ::env(GIT_TRACE)] } { } # defaults... -set wrcomcmd "git diff-tree --stdin -p --pretty" +set wrcomcmd "git diff-tree --stdin -p --pretty=email" set gitencoding {} catch { @@ -12015,7 +12302,7 @@ if {[tk windowingsystem] eq "aqua"} { set extdifftool "meld" } -set colors {green red blue magenta darkgrey brown orange} +set colors {"#00ff00" red blue magenta darkgrey brown orange} if {[tk windowingsystem] eq "win32"} { set uicolor SystemButtonFace set uifgcolor SystemButtonText @@ -12033,12 +12320,12 @@ if {[tk windowingsystem] eq "win32"} { } set diffcolors {red "#00a000" blue} set diffcontext 3 -set mergecolors {red blue green purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"} +set mergecolors {red blue "#00ff00" purple brown "#009090" magenta "#808000" "#009000" "#ff0080" cyan "#b07070" "#70b0f0" "#70f0b0" "#f0b070" "#ff70b0"} set ignorespace 0 set worddiff "" set markbgcolor "#e0e0ff" -set headbgcolor green +set headbgcolor "#00ff00" set headfgcolor black set headoutlinecolor black set remotebgcolor #ffddaa @@ -12053,7 +12340,7 @@ set linehoverfgcolor black set linehoveroutlinecolor black set mainheadcirclecolor yellow set workingfilescirclecolor red -set indexcirclecolor green +set indexcirclecolor "#00ff00" set circlecolors {white blue gray blue blue} set linkfgcolor blue set circleoutlinecolor $fgcolor @@ -12067,25 +12354,6 @@ if {[tk windowingsystem] eq "aqua"} { 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. - set gitk_msgsdir $::env(GITK_MSGSDIR) -} else { - ## Let's guess the prefix from argv0. - set gitk_prefix [file dirname [file dirname [file normalize $argv0]]] - set gitk_libdir [file join $gitk_prefix share gitk lib] - set gitk_msgsdir [file join $gitk_libdir msgs] - unset gitk_prefix -} - -## Internationalization (i18n) through msgcat and gettext. See -## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html -package require msgcat -namespace import ::msgcat::mc -## And eventually load the actual message catalog -::msgcat::mcload $gitk_msgsdir - catch { # follow the XDG base directory specification by default. See # http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html @@ -12109,6 +12377,7 @@ catch { } source $config_file } +config_check_tmp_exists 50 set config_variables { mainfont textfont uifont tabstop findmergefiles maxgraphpct maxwidth @@ -12122,6 +12391,10 @@ set config_variables { linehoveroutlinecolor mainheadcirclecolor workingfilescirclecolor indexcirclecolor circlecolors linkfgcolor circleoutlinecolor } +foreach var $config_variables { + config_init_trace $var + trace add variable $var write config_variable_change_cb +} parsefont mainfont $mainfont eval font create mainfont [fontflags mainfont] @@ -12215,6 +12488,10 @@ if {![info exists have_ttk]} { set use_ttk [expr {$have_ttk && $want_ttk}] set NS [expr {$use_ttk ? "ttk" : ""}] +if {$use_ttk} { + setttkstyle +} + regexp {^git version ([\d.]*\d)} [exec git version] _ git_version set show_notes {} @@ -12249,6 +12526,7 @@ set highlight_related [mc "None"] set highlight_files {} set viewfiles(0) {} set viewperm(0) 0 +set viewchanged(0) 0 set viewargs(0) {} set viewargscmd(0) {} @@ -12293,7 +12571,7 @@ catch { } # wait for the window to become visible tkwait visibility . -wm title . "$appname: [reponame]" +set_window_title update readrefs @@ -12307,10 +12585,11 @@ if {$cmdline_files ne {} || $revtreeargs ne {} || $revtreeargscmd ne {}} { set viewargs(1) $revtreeargs set viewargscmd(1) $revtreeargscmd set viewperm(1) 0 + set viewchanged(1) 0 set vdatemode(1) 0 addviewmenu 1 - .bar.view entryconf [mca "Edit view..."] -state normal - .bar.view entryconf [mca "Delete view"] -state normal + .bar.view entryconf [mca "&Edit view..."] -state normal + .bar.view entryconf [mca "&Delete view"] -state normal } if {[info exists permviews]} { @@ -12322,6 +12601,7 @@ if {[info exists permviews]} { set viewargs($n) [lindex $v 2] set viewargscmd($n) [lindex $v 3] set viewperm($n) 1 + set viewchanged($n) 0 addviewmenu $n } } |