Testing tangled. Original: https://github.com/j6t/gitk

Merge branch 'ml/tcltk-9'

* ml/tcltk-9:
gitk: allow Tcl/Tk 9.0+
gitk: use -profile tcl8 on encoding conversions
gitk: use -profile tcl8 for file input with Tcl 9
gitk: Tcl9 doesn't expand ~, use $env(HOME)
gitk: switch to -translation binary
gitk: update scrolling for TclTk 8.7+ / TIP 474

Signed-off-by: Johannes Sixt <j6t@kdbg.org>

Changed files
+52 -22
+52 -22
gitk
··· 7 7 # and distributed under the terms of the GNU General Public Licence, 8 8 # either version 2, or (at your option) any later version. 9 9 10 - if {[catch {package require Tcl 8.6-8.8} err]} { 10 + if {[catch {package require Tcl 8.6-} err]} { 11 11 catch {wm withdraw .} 12 12 tk_messageBox \ 13 13 -icon error \ ··· 31 31 -title "gitk: fatal error" \ 32 32 -message $message 33 33 exit 1 34 + } 35 + 36 + ###################################################################### 37 + ## Enable Tcl8 profile in Tcl9, allowing consumption of data that has 38 + ## bytes not conforming to the assumed encoding profile. 39 + 40 + if {[package vcompare $::tcl_version 9.0] >= 0} { 41 + rename open _strict_open 42 + proc open args { 43 + set f [_strict_open {*}$args] 44 + chan configure $f -profile tcl8 45 + return $f 46 + } 47 + proc convertfrom args { 48 + return [encoding convertfrom -profile tcl8 {*}$args] 49 + } 50 + } else { 51 + proc convertfrom args { 52 + return [encoding convertfrom {*}$args] 53 + } 34 54 } 35 55 36 56 ###################################################################### ··· 2290 2310 bind $cflist <MouseWheel> {$cflist yview scroll [scrollval %D 2] units} 2291 2311 bind $cflist <Shift-MouseWheel> break 2292 2312 bind $canv <Shift-MouseWheel> {$canv xview scroll [scrollval %D] units} 2313 + 2314 + if {[package vcompare $::tcl_version 8.7] >= 0} { 2315 + bindall <Alt-MouseWheel> {allcanvs yview scroll [scrollval 5*%D] units} 2316 + bindall <Alt-Shift-MouseWheel> break 2317 + bind $ctext <Alt-MouseWheel> {$ctext yview scroll [scrollval 5*%D 2] units} 2318 + bind $ctext <Alt-Shift-MouseWheel> {$ctext xview scroll [scrollval 5*%D 2] units} 2319 + bind $cflist <Alt-MouseWheel> {$cflist yview scroll [scrollval 5*%D 2] units} 2320 + bind $cflist <Alt-Shift-MouseWheel> break 2321 + bind $canv <Alt-Shift-MouseWheel> {$canv xview scroll [scrollval 5*%D] units} 2322 + } 2293 2323 } 2294 2324 2295 2325 proc bind_mousewheel_buttons {} { ··· 2749 2779 bindall <1> {selcanvline %W %x %y} 2750 2780 2751 2781 #Mouse / touchpad scrolling 2752 - if {[tk windowingsystem] == "win32"} { 2782 + if {[tk windowingsystem] == "win32" || [package vcompare $::tcl_version 8.7] >= 0} { 2753 2783 set scroll_D0 120 2754 2784 bind_mousewheel 2755 2785 } elseif {[tk windowingsystem] == "x11"} { ··· 7796 7826 set treepending $id 7797 7827 set treefilelist($id) {} 7798 7828 set treeidlist($id) {} 7799 - fconfigure $gtf -blocking 0 -encoding binary 7829 + fconfigure $gtf -blocking 0 -translation binary 7800 7830 filerun $gtf [list gettreeline $gtf $id] 7801 7831 } 7802 7832 } else { ··· 7823 7853 if {[string index $fname 0] eq "\""} { 7824 7854 set fname [lindex $fname 0] 7825 7855 } 7826 - set fname [encoding convertfrom utf-8 $fname] 7856 + set fname [convertfrom utf-8 $fname] 7827 7857 lappend treefilelist($id) $fname 7828 7858 } 7829 7859 if {![eof $gtf]} { ··· 8057 8087 8058 8088 set treepending $ids 8059 8089 set treediff {} 8060 - fconfigure $gdtf -blocking 0 -encoding binary 8090 + fconfigure $gdtf -blocking 0 -translation binary 8061 8091 filerun $gdtf [list gettreediffline $gdtf $ids] 8062 8092 } 8063 8093 ··· 8083 8113 if {[string index $file 0] eq "\""} { 8084 8114 set file [lindex $file 0] 8085 8115 } 8086 - set file [encoding convertfrom utf-8 $file] 8116 + set file [convertfrom utf-8 $file] 8087 8117 if {$file ne [lindex $treediff end]} { 8088 8118 lappend treediff $file 8089 8119 lappend sublist $file ··· 8168 8198 error_popup [mc "Error getting diffs: %s" $err] 8169 8199 return 8170 8200 } 8171 - fconfigure $bdf -blocking 0 -encoding binary -eofchar {} 8201 + fconfigure $bdf -blocking 0 -translation binary 8172 8202 set blobdifffd($ids) $bdf 8173 8203 initblobdiffvars 8174 8204 filerun $bdf [list getblobdiffline $bdf $diffids] ··· 8219 8249 global ctext curdiffstart treediffs diffencoding 8220 8250 global ctext_file_names jump_to_here targetline diffline 8221 8251 8222 - set fname [encoding convertfrom utf-8 $fname] 8252 + set fname [convertfrom utf-8 $fname] 8223 8253 set diffencoding [get_path_encoding $fname] 8224 8254 set i [lsearch -exact $treediffs($ids) $fname] 8225 8255 if {$i >= 0} { ··· 8281 8311 8282 8312 if {![string compare -length 5 "diff " $line]} { 8283 8313 if {![regexp {^diff (--cc|--git) } $line m type]} { 8284 - set line [encoding convertfrom utf-8 $line] 8314 + set line [convertfrom utf-8 $line] 8285 8315 $ctext insert end "$line\n" hunksep 8286 8316 continue 8287 8317 } ··· 8330 8360 makediffhdr $fname $ids 8331 8361 8332 8362 } elseif {![string compare -length 16 "* Unmerged path " $line]} { 8333 - set fname [encoding convertfrom utf-8 [string range $line 16 end]] 8363 + set fname [convertfrom utf-8 [string range $line 16 end]] 8334 8364 $ctext insert end "\n" 8335 8365 set curdiffstart [$ctext index "end - 1c"] 8336 8366 lappend ctext_file_names $fname ··· 8343 8373 8344 8374 } elseif {![string compare -length 2 "@@" $line]} { 8345 8375 regexp {^@@+} $line ats 8346 - set line [encoding convertfrom $diffencoding $line] 8376 + set line [convertfrom $diffencoding $line] 8347 8377 $ctext insert end "$line\n" hunksep 8348 8378 if {[regexp { \+(\d+),\d+ @@} $line m nl]} { 8349 8379 set diffline $nl ··· 8372 8402 $ctext insert end "$line\n" filesep 8373 8403 } 8374 8404 } elseif {$currdiffsubmod != "" && ![string compare -length 3 " >" $line]} { 8375 - set line [encoding convertfrom $diffencoding $line] 8405 + set line [convertfrom $diffencoding $line] 8376 8406 $ctext insert end "$line\n" dresult 8377 8407 } elseif {$currdiffsubmod != "" && ![string compare -length 3 " <" $line]} { 8378 - set line [encoding convertfrom $diffencoding $line] 8408 + set line [convertfrom $diffencoding $line] 8379 8409 $ctext insert end "$line\n" d0 8380 8410 } elseif {$diffinhdr} { 8381 8411 if {![string compare -length 12 "rename from " $line]} { ··· 8383 8413 if {[string index $fname 0] eq "\""} { 8384 8414 set fname [lindex $fname 0] 8385 8415 } 8386 - set fname [encoding convertfrom utf-8 $fname] 8416 + set fname [convertfrom utf-8 $fname] 8387 8417 set i [lsearch -exact $treediffs($ids) $fname] 8388 8418 if {$i >= 0} { 8389 8419 setinlist difffilestart $i $curdiffstart ··· 8402 8432 set diffinhdr 0 8403 8433 return 8404 8434 } 8405 - set line [encoding convertfrom utf-8 $line] 8435 + set line [convertfrom utf-8 $line] 8406 8436 $ctext insert end "$line\n" filesep 8407 8437 8408 8438 } else { 8409 8439 set line [string map {\x1A ^Z} \ 8410 - [encoding convertfrom $diffencoding $line]] 8440 + [convertfrom $diffencoding $line]] 8411 8441 # parse the prefix - one ' ', '-' or '+' for each parent 8412 8442 set prefix [string range $line 0 [expr {$diffnparents - 1}]] 8413 8443 set tag [expr {$diffnparents > 1? "m": "d"}] ··· 12348 12378 foreach row [split $rlist "\n"] { 12349 12379 if {[regexp "(.*): $attr: (.*)" $row m path value]} { 12350 12380 if {[string index $path 0] eq "\""} { 12351 - set path [encoding convertfrom utf-8 [lindex $path 0]] 12381 + set path [convertfrom utf-8 [lindex $path 0]] 12352 12382 } 12353 12383 set path_attr_cache($attr,$path) $value 12354 12384 } ··· 12581 12611 set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp] 12582 12612 } else { 12583 12613 # default XDG_CONFIG_HOME 12584 - set config_file "~/.config/git/gitk" 12585 - set config_file_tmp "~/.config/git/gitk-tmp" 12614 + set config_file "$env(HOME)/.config/git/gitk" 12615 + set config_file_tmp "$env(HOME)/.config/git/gitk-tmp" 12586 12616 } 12587 12617 if {![file exists $config_file]} { 12588 12618 # for backward compatibility use the old config file if it exists 12589 - if {[file exists "~/.gitk"]} { 12590 - set config_file "~/.gitk" 12591 - set config_file_tmp "~/.gitk-tmp" 12619 + if {[file exists "$env(HOME)/.gitk"]} { 12620 + set config_file "$env(HOME)/.gitk" 12621 + set config_file_tmp "$env(HOME)/.gitk-tmp" 12592 12622 } elseif {![file exists [file dirname $config_file]]} { 12593 12623 file mkdir [file dirname $config_file] 12594 12624 }