From 6ea3006f96f19787c949ef1e4723991756b5126b Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Fri, 6 Jun 2025 12:28:02 -0400 Subject: [PATCH 1/6] gitk: update scrolling for TclTk 8.7+ / TIP 474 TclTk 8.7 (still in alpha), and 9.0 (released), implement TIP 474 that delivers uniform handling of mouse and touchpad scrolling events on all platforms, and by default bound to most widgets. TIP 474 also implements use of the Option- modifier key (Alt- key on PC, Option- key on Macs) to indicate desire for more motion per scroll wheel event, the amplification is not defined but seems to be 5x to 10x. So, for TclTk >= 8.7 we can use identical MouseWheel bindings on all platforms, and should enable use of the Option- modifier to enable larger motion. Let's do all of this, and use a 5x multiplier for the Option- modifier. This largely follows the prior win32 model, except that Tk 8.6 does not reliably use the Option- modifier because the Alt- key conflicts with builtin behavior to activate the main menubar. Presumably this conflict is addressed in the win32 Tcl9.x package. Signed-off-by: Mark Levedahl --- gitk | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/gitk b/gitk index ba112586be..700d5d152d 100755 --- a/gitk +++ b/gitk @@ -2273,6 +2273,16 @@ proc bind_mousewheel {} { bind $cflist {$cflist yview scroll [scrollval %D 2] units} bind $cflist break bind $canv {$canv xview scroll [scrollval %D] units} + + if {[package vcompare $::tcl_version 8.7] >= 0} { + bindall {allcanvs yview scroll [scrollval 5*%D] units} + bindall break + bind $ctext {$ctext yview scroll [scrollval 5*%D 2] units} + bind $ctext {$ctext xview scroll [scrollval 5*%D 2] units} + bind $cflist {$cflist yview scroll [scrollval 5*%D 2] units} + bind $cflist break + bind $canv {$canv xview scroll [scrollval 5*%D] units} + } } proc bind_mousewheel_buttons {} { @@ -2732,7 +2742,7 @@ proc makewindow {} { bindall <1> {selcanvline %W %x %y} #Mouse / touchpad scrolling - if {[tk windowingsystem] == "win32"} { + if {[tk windowingsystem] == "win32" || [package vcompare $::tcl_version 8.7] >= 0} { set scroll_D0 120 bind_mousewheel } elseif {[tk windowingsystem] == "x11"} { From ab30c04e9c7a5dd61767646a345ba364f70f6977 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 25 Mar 2025 16:53:20 -0400 Subject: [PATCH 2/6] gitk: switch to -translation binary gitk uses '-encoding binary' in several places to handle non-text data. Per TIP 699, this is not recommended as there has been too much confusion and misconfiguration of binary channels, and this option is removed in Tcl 9. Tcl defines a binary channel as one that reproduces the input data exactly. As Tcl stores all data internally in unicode format, a binary channel requires 3 things: - -encoding iso8859-1 : this causes each byte of input to be translated to its unicode equivalent (may be multi-byte). - -translation lf : this avoids any translation of line endings, which by default are translated to \n on input. - -eofchar {} : this avoids any use of an end of file character, which is ctrl-z by default on Windows. The recommended '-translation binary' makes all three settings, but this is not done in gitk now. Rather, gitk uses '-encoding binary', which is an alias to '-encoding iso8859-1' removed by TIP 699, in multiple places, and -eofchar {} in one place but not all. All other files, configured in non-binary fashion, have -eofchar {}. Unix and Windows differ on line ending conventions, Tcl by default converts line endings to \n on input, and to those common on the platform on output. git emits only \n on Unix or Windows. Also, Tcl's proc gets recognizes and removes \n, \r, or \r\n as line endings, and this is used by gitk except in procs selectline and parsecommit. But, those two procs recognize any combination of \n and \r as terminating a line. So, there is no need to translate line endings on input, and using -translation binary avoids any such translation. Tcl sets eofchar to ctrl-z (ascii \0x1a) only on Windows, otherwise eofchar is {}. This provides compatibility to old DOS based codes and files originating when file systems recorded only sectors allocated, and not bytes used. git does not use ctrl-z to terminate data anywhere. Only two channels in gitk leave eofchar at the default value, both use -encoding binary now. A third one was converted in commit 681c3290e3 ("gitk: Handle blobs containing a DOS end-of-file marker", 2009-03-16), fixing such a problem of early data termination. Using eofchar {} is correct, even if not always necessary. Tcl 9 forces change, using -translation binary per TIP 699 does what gitk needs and is backwards compatible to Tcl 8.x. Do it. Signed-off-by: Mark Levedahl --- gitk | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gitk b/gitk index 700d5d152d..cc6f720163 100755 --- a/gitk +++ b/gitk @@ -7783,7 +7783,7 @@ proc gettree {id} { set treepending $id set treefilelist($id) {} set treeidlist($id) {} - fconfigure $gtf -blocking 0 -encoding binary + fconfigure $gtf -blocking 0 -translation binary filerun $gtf [list gettreeline $gtf $id] } } else { @@ -8044,7 +8044,7 @@ proc gettreediffs {ids} { set treepending $ids set treediff {} - fconfigure $gdtf -blocking 0 -encoding binary + fconfigure $gdtf -blocking 0 -translation binary filerun $gdtf [list gettreediffline $gdtf $ids] } @@ -8155,7 +8155,7 @@ proc getblobdiffs {ids} { error_popup [mc "Error getting diffs: %s" $err] return } - fconfigure $bdf -blocking 0 -encoding binary -eofchar {} + fconfigure $bdf -blocking 0 -translation binary set blobdifffd($ids) $bdf initblobdiffvars filerun $bdf [list getblobdiffline $bdf $diffids] From bcf94fe072615b5ca2ecae683fb2bc58876cabdf Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Mon, 24 Mar 2025 08:45:32 -0400 Subject: [PATCH 3/6] gitk: Tcl9 doesn't expand ~, use $env(HOME) gitk looks for configuration files under $(HOME)/.., and uses the typical shortcut formats to find this, e.g., ~/.config/. This relies upon Tcl expanding such constructs to replace ~ with $(HOME). But, Tcl 9 has stopped doing that for various reasons, and now supplies [file tildeexpand ...] to perform this expansion. There are a very few places that need this expansion, and all must be modified regardless of approach taken. POSIX specifies that $HOME be defined at the time of login, and both Cygwin and MSYS (underlying git for windows) set this variable. Tcl8 uses the POSIX defined pwnam to look up the underlying database record on Unix, but will get the same result as using $HOME on any POSIX compliant system. On Windows, Tcl just accesses $HOME, falling back to other environment variables if $HOME is not set. Git for Windows has $HOME defined by MSYS, so this works just as on the others. As $env(HOME) works in Tcl 8 and 9, while anything using [file tildeexpand ... ] will not, let's use the simpler approach as doing so adds no lines of code. Signed-off-by: Mark Levedahl --- gitk | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/gitk b/gitk index cc6f720163..d9812f2e9c 100755 --- a/gitk +++ b/gitk @@ -12469,14 +12469,14 @@ catch { set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp] } else { # default XDG_CONFIG_HOME - set config_file "~/.config/git/gitk" - set config_file_tmp "~/.config/git/gitk-tmp" + set config_file "$env(HOME)/.config/git/gitk" + set config_file_tmp "$env(HOME)/.config/git/gitk-tmp" } if {![file exists $config_file]} { # for backward compatibility use the old config file if it exists - if {[file exists "~/.gitk"]} { - set config_file "~/.gitk" - set config_file_tmp "~/.gitk-tmp" + if {[file exists "$env(HOME)/.gitk"]} { + set config_file "$env(HOME)/.gitk" + set config_file_tmp "$env(HOME)/.gitk-tmp" } elseif {![file exists [file dirname $config_file]]} { file mkdir [file dirname $config_file] } From aa1b8d31acbcc7630e1ca2f2bbd27eeb34b00446 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Fri, 14 Mar 2025 11:45:35 -0400 Subject: [PATCH 4/6] gitk: use -profile tcl8 for file input with Tcl 9 gitk invokes many git commands expecting output in utf-8 encoding, but git accepts extended ascii (code page unknown) as utf-8 without validating, so cannot guarantee valid utf-8 on output. In particular, using any extended ascii code page, of which there are many, has long been acceptable given that everyone on a project is aware of and uses that same code page to view all data. utf-8 accepts only 7-bit ascii characters in single bytes, and any characters outside of that base set require at least two bytes. Tcl is a string based language, and transcodes all input data to an internal unicode format, and to whatever format is requested on output: "pure" binary is recoded using iso8859-1. Tcl8.x silently recodes invalid utf-8 as binary data, so extended ascii characters maintain their binary value on output but may not display correctly. Tcl 8.7 added three profiles to control this behaviour: strict (raises exceptions), replace (replaces each invalid byte with ?), and the default tcl8 maintaining the old behavior. Tcl 9 changes the default profile to strict, meaning any invalid utf-8 raises an exception that gitk does not handle. An example of this in the git repository is commit 7eb93c8965 ("[PATCH] Simplify git script", 2005-09-07). This includes extended ascii characters in the author name and commit message. As a result, gitk + Tcl 9 cannot view the git repository at any point beyond that commit. Note: Tcl 9.0 has a bug, to be fixed in 9.1, where this particular condition results in a memory error causing Tcl to crash [1]. The tcl8 profile used so far has acceptable behavior given gitk's acceptance: this allows gitk to accept extended ascii though it may display incorrectly. Let's continue that behavior by overriding open to use the tcl8 profile on Tcl9 and later: Tcl 8.6 does not understand fconfigure -profile, and Tcl 8.7 maintains the tcl8 profile. [1] Per https://core.tcl-lang.org/tcl/tktview/73bb42fb3f35cd613af6fcea465e35bbfd352216 Signed-off-by: Mark Levedahl --- gitk | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/gitk b/gitk index d9812f2e9c..342b0aba8d 100755 --- a/gitk +++ b/gitk @@ -33,6 +33,19 @@ The version of git found is $git_version." exit 1 } +###################################################################### +## Enable Tcl8 profile in Tcl9, allowing consumption of data that has +## bytes not conforming to the assumed encoding profile. + +if {[package vcompare $::tcl_version 9.0] >= 0} { + rename open _strict_open + proc open args { + set f [_strict_open {*}$args] + chan configure $f -profile tcl8 + return $f + } +} + ###################################################################### ## ## Enabling platform-specific code paths From ac222bc02df9aef49d4a6ee839762c2902961a21 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Sun, 18 May 2025 10:41:30 -0400 Subject: [PATCH 5/6] gitk: use -profile tcl8 on encoding conversions gitk in the prior commit learned to apply -profile tcl8 to all input data streams, avoiding errors on non-binary data streams whose encoding is not utf-8. But, gitk also consumes binary data streams (generally blobs from commits), and internally decodes this to support various displays. With Tcl9, errors occur in this decoding for the same reasons described in the previous commit: basically, the underlying data was not validated to conform to the given encoding, and this source encoding may not be utf-8. gitk performs this decoding using Tcl's '[encoding convert from' operator. For example, the 7th commit in gitk's history has the extended ascii value 0xA9, so gitk 9a40c50c1e in gitk's repository raises an exception. The error log has: unexpected byte sequence starting at index 11: '\xA9' while executing "encoding convertfrom $diffencoding $line" (procedure "parseblobdiffline" line 135) invoked from within "parseblobdiffline $ids $line" (procedure "getblobdiffline" line 16) invoked from within "getblobdiffline file6 9a40c50c1e05c0658b7a7c68b56d615eb6f170dd" ("eval" body line 1) invoked from within "eval $script" (procedure "dorunq" line 11) invoked from within "dorunq" ("after" script) This problem has a similar fix to the prior issue: we must use the tlc8 profile when converting this data. Do so, again only on Tcl9 as Tcl8.6 does not recognize -profile, and only Tcl 9.0 makes strict the default. Signed-off-by: Mark Levedahl --- gitk | 31 +++++++++++++++++++------------ 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/gitk b/gitk index 342b0aba8d..09c11041e8 100755 --- a/gitk +++ b/gitk @@ -44,6 +44,13 @@ if {[package vcompare $::tcl_version 9.0] >= 0} { chan configure $f -profile tcl8 return $f } + proc convertfrom args { + return [encoding convertfrom -profile tcl8 {*}$args] + } +} else { + proc convertfrom args { + return [encoding convertfrom {*}$args] + } } ###################################################################### @@ -7823,7 +7830,7 @@ proc gettreeline {gtf id} { if {[string index $fname 0] eq "\""} { set fname [lindex $fname 0] } - set fname [encoding convertfrom utf-8 $fname] + set fname [convertfrom utf-8 $fname] lappend treefilelist($id) $fname } if {![eof $gtf]} { @@ -8083,7 +8090,7 @@ proc gettreediffline {gdtf ids} { if {[string index $file 0] eq "\""} { set file [lindex $file 0] } - set file [encoding convertfrom utf-8 $file] + set file [convertfrom utf-8 $file] if {$file ne [lindex $treediff end]} { lappend treediff $file lappend sublist $file @@ -8219,7 +8226,7 @@ proc makediffhdr {fname ids} { global ctext curdiffstart treediffs diffencoding global ctext_file_names jump_to_here targetline diffline - set fname [encoding convertfrom utf-8 $fname] + set fname [convertfrom utf-8 $fname] set diffencoding [get_path_encoding $fname] set i [lsearch -exact $treediffs($ids) $fname] if {$i >= 0} { @@ -8281,7 +8288,7 @@ proc parseblobdiffline {ids line} { if {![string compare -length 5 "diff " $line]} { if {![regexp {^diff (--cc|--git) } $line m type]} { - set line [encoding convertfrom utf-8 $line] + set line [convertfrom utf-8 $line] $ctext insert end "$line\n" hunksep continue } @@ -8330,7 +8337,7 @@ proc parseblobdiffline {ids line} { makediffhdr $fname $ids } elseif {![string compare -length 16 "* Unmerged path " $line]} { - set fname [encoding convertfrom utf-8 [string range $line 16 end]] + set fname [convertfrom utf-8 [string range $line 16 end]] $ctext insert end "\n" set curdiffstart [$ctext index "end - 1c"] lappend ctext_file_names $fname @@ -8343,7 +8350,7 @@ proc parseblobdiffline {ids line} { } elseif {![string compare -length 2 "@@" $line]} { regexp {^@@+} $line ats - set line [encoding convertfrom $diffencoding $line] + set line [convertfrom $diffencoding $line] $ctext insert end "$line\n" hunksep if {[regexp { \+(\d+),\d+ @@} $line m nl]} { set diffline $nl @@ -8372,10 +8379,10 @@ proc parseblobdiffline {ids line} { $ctext insert end "$line\n" filesep } } elseif {$currdiffsubmod != "" && ![string compare -length 3 " >" $line]} { - set line [encoding convertfrom $diffencoding $line] + set line [convertfrom $diffencoding $line] $ctext insert end "$line\n" dresult } elseif {$currdiffsubmod != "" && ![string compare -length 3 " <" $line]} { - set line [encoding convertfrom $diffencoding $line] + set line [convertfrom $diffencoding $line] $ctext insert end "$line\n" d0 } elseif {$diffinhdr} { if {![string compare -length 12 "rename from " $line]} { @@ -8383,7 +8390,7 @@ proc parseblobdiffline {ids line} { if {[string index $fname 0] eq "\""} { set fname [lindex $fname 0] } - set fname [encoding convertfrom utf-8 $fname] + set fname [convertfrom utf-8 $fname] set i [lsearch -exact $treediffs($ids) $fname] if {$i >= 0} { setinlist difffilestart $i $curdiffstart @@ -8402,12 +8409,12 @@ proc parseblobdiffline {ids line} { set diffinhdr 0 return } - set line [encoding convertfrom utf-8 $line] + set line [convertfrom utf-8 $line] $ctext insert end "$line\n" filesep } else { set line [string map {\x1A ^Z} \ - [encoding convertfrom $diffencoding $line]] + [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"}] @@ -12279,7 +12286,7 @@ proc cache_gitattr {attr pathlist} { foreach row [split $rlist "\n"] { if {[regexp "(.*): $attr: (.*)" $row m path value]} { if {[string index $path 0] eq "\""} { - set path [encoding convertfrom utf-8 [lindex $path 0]] + set path [convertfrom utf-8 [lindex $path 0]] } set path_attr_cache($attr,$path) $value } From 4e605b7bc06f3a19ca5c80088d16b2827a855c84 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Thu, 20 Mar 2025 14:16:07 -0400 Subject: [PATCH 6/6] gitk: allow Tcl/Tk 9.0+ Tcl/Tk 9.0 has been released, and has shipped in Fedora 42. Prior patches in this sequence have addressed known incompatibilities, so gitk is now operating with Tcl9. So, let's allow Tcl9. Signed-off-by: Mark Levedahl --- gitk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gitk b/gitk index 09c11041e8..3752a2c1dc 100755 --- a/gitk +++ b/gitk @@ -7,7 +7,7 @@ exec wish "$0" -- "$@" # and distributed under the terms of the GNU General Public Licence, # either version 2, or (at your option) any later version. -if {[catch {package require Tcl 8.6-8.8} err]} { +if {[catch {package require Tcl 8.6-} err]} { catch {wm withdraw .} tk_messageBox \ -icon error \