diff --git a/gitk b/gitk index 5be8b2a..05dd994 100755 --- a/gitk +++ b/gitk @@ -7,7 +7,31 @@ exec wish "$0" -- "$@" # and distributed under the terms of the GNU General Public Licence, # either version 2, or (at your option) any later version. -package require Tk +if {[catch {package require Tcl 8.6-8.8} err]} { + catch {wm withdraw .} + tk_messageBox \ + -icon error \ + -type ok \ + -title "gitk: fatal error" \ + -message $err + exit 1 +} + +set MIN_GIT_VERSION 2.20 +regexp {^git version ([\d.]*\d)} [exec git version] _ git_version +if {[package vcompare $git_version $MIN_GIT_VERSION] < 0} { + set message "The git executable found is too old. +The minimum required version is $MIN_GIT_VERSION.0. +The version of git found is $git_version." + + catch {wm withdraw .} + tk_messageBox \ + -icon error \ + -type ok \ + -title "gitk: fatal error" \ + -message $message + exit 1 +} ###################################################################### ## @@ -345,7 +369,7 @@ proc unmerged_files {files} { proc parseviewargs {n arglist} { global vdatemode vmergeonly vflags vdflags vrevs vfiltered vorigargs env global vinlinediff - global worddiff git_version + global worddiff set vdatemode($n) 0 set vmergeonly($n) 0 @@ -396,14 +420,10 @@ proc parseviewargs {n arglist} { "--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"] - } + set worddiff [mc "Color words"] } "--word-diff*" { - if {[package vcompare $git_version "1.7.2"] >= 0} { - set worddiff [mc "Markup words"] - } + set worddiff [mc "Markup words"] } "--stat=*" - "--numstat" - "--shortstat" - "--summary" - "--check" - "--exit-code" - "--quiet" - "--topo-order" - @@ -551,7 +571,6 @@ proc start_rev_list {view} { 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 @@ -601,7 +620,7 @@ proc start_rev_list {view} { } if {[catch { - set fd [safe_open_command_redirect [concat git log --no-color -z --pretty=raw $show_notes \ + set fd [safe_open_command_redirect [concat git log --no-color -z --pretty=raw --show-notes \ --parents --boundary $args --stdin] \ [list "<<[join [concat $revs "--" $files] "\n"]"]] } err]} { @@ -697,7 +716,6 @@ proc updatecommits {} { global mainheadid viewmainheadid viewmainheadid_orig pending_select global hasworktree global varcid vposids vnegids vflags vrevs - global show_notes set hasworktree [hasworktree] rereadrefs @@ -754,7 +772,7 @@ proc updatecommits {} { set args $vorigargs($view) } if {[catch { - set fd [safe_open_command_redirect [concat git log --no-color -z --pretty=raw $show_notes \ + set fd [safe_open_command_redirect [concat git log --no-color -z --pretty=raw --show-notes \ --parents --boundary $args --stdin] \ [list "<<[join [concat $revs "--" $vfilelimit($view)] "\n"]"]] } err]} { @@ -2071,23 +2089,12 @@ proc removehead {id name} { } proc ttk_toplevel {w args} { - global use_ttk eval [linsert $args 0 ::toplevel $w] - if {$use_ttk} { - place [ttk::frame $w._toplevel_background] -x 0 -y 0 -relwidth 1 -relheight 1 - } + 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 @@ -2098,12 +2105,10 @@ proc make_transient {window origin} { } proc show_error {w top msg} { - global NS - if {![info exists NS]} {set NS ""} if {[wm state $top] eq "withdrawn"} { wm deiconify $top } message $w.m -text $msg -justify center -aspect 400 pack $w.m -side top -fill x -padx 20 -pady 20 - ${NS}::button $w.ok -default active -text [mc OK] -command "destroy $top" + ttk::button $w.ok -default active -text [mc OK] -command "destroy $top" pack $w.ok -side bottom -fill x bind $top "grab $top; focus $top" bind $top "destroy $top" @@ -2125,16 +2130,16 @@ proc error_popup {msg {owner .}} { } proc confirm_popup {msg {owner .}} { - global confirm_ok NS + global confirm_ok set confirm_ok 0 set w .confirm ttk_toplevel $w make_transient $w $owner message $w.m -text $msg -justify center -aspect 400 pack $w.m -side top -fill x -padx 20 -pady 20 - ${NS}::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w" + ttk::button $w.ok -text [mc OK] -command "set confirm_ok 1; destroy $w" pack $w.ok -side left -fill x - ${NS}::button $w.cancel -text [mc Cancel] -command "destroy $w" + ttk::button $w.cancel -text [mc Cancel] -command "destroy $w" pack $w.cancel -side right -fill x bind $w "grab $w; focus $w" bind $w "set confirm_ok 1; destroy $w" @@ -2150,8 +2155,6 @@ proc haveselectionclipboard {} { } proc setoptions {} { - global use_ttk - if {[tk windowingsystem] ne "win32"} { option add *Panedwindow.showHandle 1 startupFile option add *Panedwindow.sashRelief raised startupFile @@ -2244,23 +2247,52 @@ proc cleardropsel {w} { $w selection clear } proc makedroplist {w varname args} { - global use_ttk - if {$use_ttk} { - set width 0 - foreach label $args { - set cx [string length $label] - if {$cx > $width} {set width $cx} - } - set gm [ttk::combobox $w -width $width -state readonly\ - -textvariable $varname -values $args \ - -exportselection false] - bind $gm <> [list $gm selection clear] - } else { - set gm [eval [linsert $args 0 tk_optionMenu $w $varname]] - } + set width 0 + foreach label $args { + set cx [string length $label] + if {$cx > $width} {set width $cx} + } + set gm [ttk::combobox $w -width $width -state readonly\ + -textvariable $varname -values $args \ + -exportselection false] + bind $gm <> [list $gm selection clear] return $gm } +proc scrollval {D {koff 0}} { + global kscroll scroll_D0 + return [expr int(-($D / $scroll_D0) * max(1, $kscroll-$koff))] +} + +proc bind_mousewheel {} { + global canv cflist ctext + bindall {allcanvs yview scroll [scrollval %D] units} + bindall break + bind $ctext {$ctext yview scroll [scrollval %D 2] units} + bind $ctext {$ctext xview scroll [scrollval %D 2] units} + bind $cflist {$cflist yview scroll [scrollval %D 2] units} + bind $cflist break + bind $canv {$canv xview scroll [scrollval %D] units} +} + +proc bind_mousewheel_buttons {} { + global canv cflist ctext + bindall {allcanvs yview scroll [scrollval 1] units} + bindall {allcanvs yview scroll [scrollval -1] units} + bindall break + bindall break + bind $ctext {$ctext yview scroll [scrollval 1 2] units} + bind $ctext {$ctext yview scroll [scrollval -1 2] units} + bind $ctext {$ctext xview scroll [scrollval 1 2] units} + bind $ctext {$ctext xview scroll [scrollval -1 2] units} + bind $cflist {$cflist yview scroll [scrollval 1 2] units} + bind $cflist {$cflist yview scroll [scrollval -1 2] units} + bind $cflist break + bind $cflist break + bind $canv {$canv xview scroll [scrollval 1] units} + bind $canv {$canv xview scroll [scrollval -1] units} +} + proc makewindow {} { global canv canv2 canv3 linespc charspc ctext cflist cscroll global tabstop @@ -2279,9 +2311,8 @@ proc makewindow {} { global headctxmenu progresscanv progressitem progresscoords statusw global fprogitem fprogcoord lastprogupdate progupdatepending global rprogitem rprogcoord rownumsel numcommits - global have_tk85 have_tk86 use_ttk NS - global git_version global worddiff + global scroll_D0 # The "mc" arguments here are purely so that xgettext # sees the following string as needing to be translated @@ -2333,13 +2364,11 @@ proc makewindow {} { 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 - } + # cover the non-themed toplevel with a themed frame. + place [ttk::frame ._main_background] -x 0 -y 0 -relwidth 1 -relheight 1 # the gui has upper and lower half, parts of a paned window. - ${NS}::panedwindow .ctop -orient vertical + ttk::panedwindow .ctop -orient vertical # possibly use assumed geometry if {![info exists geometry(pwsash0)]} { @@ -2352,12 +2381,9 @@ proc makewindow {} { } # the upper half will have a paned window, a scroll bar to the right, and some stuff below - ${NS}::frame .tf -height $geometry(topheight) -width $geometry(topwidth) - ${NS}::frame .tf.histframe - ${NS}::panedwindow .tf.histframe.pwclist -orient horizontal - if {!$use_ttk} { - .tf.histframe.pwclist configure -sashpad 0 -handlesize 4 - } + ttk::frame .tf -height $geometry(topheight) -width $geometry(topwidth) + ttk::frame .tf.histframe + ttk::panedwindow .tf.histframe.pwclist -orient horizontal # create three canvases set cscroll .tf.histframe.csb @@ -2365,6 +2391,7 @@ proc makewindow {} { canvas $canv \ -selectbackground $selectbgcolor \ -background $bgcolor -bd 0 \ + -xscrollincr $linespc \ -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll" .tf.histframe.pwclist add $canv set canv2 .tf.histframe.pwclist.canv2 @@ -2377,28 +2404,22 @@ proc makewindow {} { -selectbackground $selectbgcolor \ -background $bgcolor -bd 0 -yscrollincr $linespc .tf.histframe.pwclist add $canv3 - if {$use_ttk} { - bind .tf.histframe.pwclist { - bind %W {} - .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0] - .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0] - } - } else { - eval .tf.histframe.pwclist sash place 0 $geometry(pwsash0) - eval .tf.histframe.pwclist sash place 1 $geometry(pwsash1) + bind .tf.histframe.pwclist { + bind %W {} + .tf.histframe.pwclist sashpos 1 [lindex $::geometry(pwsash1) 0] + .tf.histframe.pwclist sashpos 0 [lindex $::geometry(pwsash0) 0] } # a scroll bar to rule them - ${NS}::scrollbar $cscroll -command {allcanvs yview} - if {!$use_ttk} {$cscroll configure -highlightthickness 0} + ttk::scrollbar $cscroll -command {allcanvs yview} pack $cscroll -side right -fill y bind .tf.histframe.pwclist {resizeclistpanes %W %w} lappend bglist $canv $canv2 $canv3 pack .tf.histframe.pwclist -fill both -expand 1 -side left # we have two button bars at bottom of top frame. Bar 1 - ${NS}::frame .tf.bar - ${NS}::frame .tf.lbar -height 15 + ttk::frame .tf.bar + ttk::frame .tf.lbar -height 15 set sha1entry .tf.bar.sha1 set entries $sha1entry @@ -2407,7 +2428,7 @@ proc makewindow {} { -command gotocommit -width 8 $sha1but conf -disabledforeground [$sha1but cget -foreground] pack .tf.bar.sha1label -side left - ${NS}::entry $sha1entry -width 40 -font textfont -textvariable sha1string + ttk::entry $sha1entry -width 40 -font textfont -textvariable sha1string trace add variable sha1string write sha1change pack $sha1entry -side left -pady 2 @@ -2432,50 +2453,30 @@ proc makewindow {} { image create bitmap bm-right -data $bm_right_data -foreground $uifgcolor image create bitmap bm-right-gray -data $bm_right_data -foreground $uifgdisabledcolor - ${NS}::button .tf.bar.leftbut -command goback -state disabled -width 26 - if {$use_ttk} { - .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray] - } else { - .tf.bar.leftbut configure -image bm-left - } + ttk::button .tf.bar.leftbut -command goback -state disabled -width 26 + .tf.bar.leftbut configure -image [list bm-left disabled bm-left-gray] pack .tf.bar.leftbut -side left -fill y - ${NS}::button .tf.bar.rightbut -command goforw -state disabled -width 26 - if {$use_ttk} { - .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray] - } else { - .tf.bar.rightbut configure -image bm-right - } + ttk::button .tf.bar.rightbut -command goforw -state disabled -width 26 + .tf.bar.rightbut configure -image [list bm-right disabled bm-right-gray] pack .tf.bar.rightbut -side left -fill y - ${NS}::label .tf.bar.rowlabel -text [mc "Row"] + ttk::label .tf.bar.rowlabel -text [mc "Row"] set rownumsel {} - ${NS}::label .tf.bar.rownum -width 7 -textvariable rownumsel \ + ttk::label .tf.bar.rownum -width 7 -textvariable rownumsel \ -relief sunken -anchor e - ${NS}::label .tf.bar.rowlabel2 -text "/" - ${NS}::label .tf.bar.numcommits -width 7 -textvariable numcommits \ + ttk::label .tf.bar.rowlabel2 -text "/" + ttk::label .tf.bar.numcommits -width 7 -textvariable numcommits \ -relief sunken -anchor e pack .tf.bar.rowlabel .tf.bar.rownum .tf.bar.rowlabel2 .tf.bar.numcommits \ -side left - if {!$use_ttk} { - foreach w {rownum numcommits} {.tf.bar.$w configure -font textfont} - } global selectedline trace add variable selectedline write selectedline_change # Status label and progress bar set statusw .tf.bar.status - ${NS}::label $statusw -width 15 -relief sunken + ttk::label $statusw -width 15 -relief sunken pack $statusw -side left -padx 5 - if {$use_ttk} { - set progresscanv [ttk::progressbar .tf.bar.progress] - } else { - set h [expr {[font metrics uifont -linespace] + 2}] - set progresscanv .tf.bar.progress - canvas $progresscanv -relief sunken -height $h -borderwidth 2 - set progressitem [$progresscanv create rect -1 0 0 $h -fill "#00ff00"] - set fprogitem [$progresscanv create rect -1 0 0 $h -fill yellow] - set rprogitem [$progresscanv create rect -1 0 0 $h -fill red] - } + set progresscanv [ttk::progressbar .tf.bar.progress] pack $progresscanv -side right -expand 1 -fill x -padx {0 2} set progresscoords {0 0} set fprogcoord 0 @@ -2485,7 +2486,7 @@ proc makewindow {} { set progupdatepending 0 # build up the bottom bar of upper window - ${NS}::label .tf.lbar.flabel -text "[mc "Find"] " + ttk::label .tf.lbar.flabel -text "[mc "Find"] " set bm_down_data { #define down_width 16 @@ -2497,7 +2498,7 @@ proc makewindow {} { 0xf0, 0x0f, 0xe0, 0x07, 0xc0, 0x03, 0x80, 0x01}; } image create bitmap bm-down -data $bm_down_data -foreground $uifgcolor - ${NS}::button .tf.lbar.fnext -width 26 -command {dofind 1 1} + ttk::button .tf.lbar.fnext -width 26 -command {dofind 1 1} .tf.lbar.fnext configure -image bm-down set bm_up_data { @@ -2510,10 +2511,10 @@ proc makewindow {} { 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01}; } image create bitmap bm-up -data $bm_up_data -foreground $uifgcolor - ${NS}::button .tf.lbar.fprev -width 26 -command {dofind -1 1} + ttk::button .tf.lbar.fprev -width 26 -command {dofind -1 1} .tf.lbar.fprev configure -image bm-up - ${NS}::label .tf.lbar.flab2 -text " [mc "commit"] " + ttk::label .tf.lbar.flab2 -text " [mc "commit"] " pack .tf.lbar.flabel .tf.lbar.fnext .tf.lbar.fprev .tf.lbar.flab2 \ -side left -fill y @@ -2529,7 +2530,7 @@ proc makewindow {} { set findstring {} set fstring .tf.lbar.findstring lappend entries $fstring - ${NS}::entry $fstring -width 30 -textvariable findstring + ttk::entry $fstring -width 30 -textvariable findstring trace add variable findstring write find_change set findtype [mc "Exact"] set findtypemenu [makedroplist .tf.lbar.findtype \ @@ -2548,45 +2549,41 @@ proc makewindow {} { pack .tf.bar -in .tf -side bottom -fill x pack .tf.histframe -fill both -side top -expand 1 .ctop add .tf - if {!$use_ttk} { - .ctop paneconfigure .tf -height $geometry(topheight) - .ctop paneconfigure .tf -width $geometry(topwidth) - } # now build up the bottom - ${NS}::panedwindow .pwbottom -orient horizontal + ttk::panedwindow .pwbottom -orient horizontal # lower left, a text box over search bar, scroll bar to the right # if we know window height, then that will set the lower text height, otherwise # we set lower text height which will drive window height if {[info exists geometry(main)]} { - ${NS}::frame .bleft -width $geometry(botwidth) + ttk::frame .bleft -width $geometry(botwidth) } else { - ${NS}::frame .bleft -width $geometry(botwidth) -height $geometry(botheight) + ttk::frame .bleft -width $geometry(botwidth) -height $geometry(botheight) } - ${NS}::frame .bleft.top - ${NS}::frame .bleft.mid - ${NS}::frame .bleft.bottom + ttk::frame .bleft.top + ttk::frame .bleft.mid + ttk::frame .bleft.bottom # gap between sub-widgets set wgap [font measure uifont "i"] - ${NS}::button .bleft.top.search -text [mc "Search"] -command dosearch + ttk::button .bleft.top.search -text [mc "Search"] -command dosearch pack .bleft.top.search -side left -padx 5 set sstring .bleft.top.sstring set searchstring "" - ${NS}::entry $sstring -width 20 -textvariable searchstring + ttk::entry $sstring -width 20 -textvariable searchstring lappend entries $sstring trace add variable searchstring write incrsearch pack $sstring -side left -expand 1 -fill x - ${NS}::radiobutton .bleft.mid.diff -text [mc "Diff"] \ + ttk::radiobutton .bleft.mid.diff -text [mc "Diff"] \ -command changediffdisp -variable diffelide -value {0 0} - ${NS}::radiobutton .bleft.mid.old -text [mc "Old version"] \ + ttk::radiobutton .bleft.mid.old -text [mc "Old version"] \ -command changediffdisp -variable diffelide -value {0 1} - ${NS}::radiobutton .bleft.mid.new -text [mc "New version"] \ + ttk::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"]: " + ttk::label .bleft.mid.labeldiffcontext -text " [mc "Lines of context"]: " pack .bleft.mid.diff .bleft.mid.old .bleft.mid.new -side left -ipadx $wgap spinbox .bleft.mid.diffcontext -width 5 \ -from 0 -increment 1 -to 10000000 \ @@ -2596,28 +2593,24 @@ proc makewindow {} { trace add variable diffcontextstring write diffcontextchange lappend entries .bleft.mid.diffcontext pack .bleft.mid.labeldiffcontext .bleft.mid.diffcontext -side left -ipadx $wgap - ${NS}::checkbutton .bleft.mid.ignspace -text [mc "Ignore space change"] \ + ttk::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 - } + makedroplist .bleft.mid.worddiff worddiff [mc "Line diff"] \ + [mc "Markup words"] [mc "Color words"] + trace add variable worddiff write changeworddiff + pack .bleft.mid.worddiff -side left -padx 5 set ctext .bleft.bottom.ctext text $ctext -background $bgcolor -foreground $fgcolor \ -state disabled -undo 0 -font textfont \ -yscrollcommand scrolltext -wrap $wrapdefault \ -xscrollcommand ".bleft.bottom.sbhorizontal set" - if {$have_tk85} { - $ctext conf -tabstyle wordprocessor - } - ${NS}::scrollbar .bleft.bottom.sb -command "$ctext yview" - ${NS}::scrollbar .bleft.bottom.sbhorizontal -command "$ctext xview" -orient h + $ctext conf -tabstyle wordprocessor + ttk::scrollbar .bleft.bottom.sb -command "$ctext yview" + ttk::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 @@ -2668,16 +2661,13 @@ proc makewindow {} { $ctext tag lower d0 .pwbottom add .bleft - if {!$use_ttk} { - .pwbottom paneconfigure .bleft -width $geometry(botwidth) - } # lower right - ${NS}::frame .bright - ${NS}::frame .bright.mode - ${NS}::radiobutton .bright.mode.patch -text [mc "Patch"] \ + ttk::frame .bright + ttk::frame .bright.mode + ttk::radiobutton .bright.mode.patch -text [mc "Patch"] \ -command reselectline -variable cmitmode -value "patch" - ${NS}::radiobutton .bright.mode.tree -text [mc "Tree"] \ + ttk::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 @@ -2693,7 +2683,7 @@ proc makewindow {} { -spacing1 1 -spacing3 1 lappend bglist $cflist lappend fglist $cflist - ${NS}::scrollbar .bright.sb -command "$cflist yview" + ttk::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 \ @@ -2728,44 +2718,31 @@ proc makewindow {} { set ::BM "2" } - if {$use_ttk} { - bind .ctop { - bind %W {} - %W sashpos 0 $::geometry(topheight) - } - bind .pwbottom { - bind %W {} - %W sashpos 0 $::geometry(botwidth) - } - bind .pwbottom {resizecdetpanes %W %w} + bind .ctop { + bind %W {} + %W sashpos 0 $::geometry(topheight) } + bind .pwbottom { + bind %W {} + %W sashpos 0 $::geometry(botwidth) + } + bind .pwbottom {resizecdetpanes %W %w} pack .ctop -fill both -expand 1 bindall <1> {selcanvline %W %x %y} - #bindall {selcanvline %W %x %y} + + #Mouse / touchpad scrolling if {[tk windowingsystem] == "win32"} { - bind . { windows_mousewheel_redirector %W %X %Y %D } - bind $ctext { windows_mousewheel_redirector %W %X %Y %D ; break } + set scroll_D0 120 + bind_mousewheel + } elseif {[tk windowingsystem] == "x11"} { + set scroll_D0 1 + bind_mousewheel_buttons + } elseif {[tk windowingsystem] == "aqua"} { + set scroll_D0 1 + bind_mousewheel } else { - bindall "allcanvs yview scroll -5 units" - bindall "allcanvs yview scroll 5 units" - bind $ctext