Skip to content

Commit 148e914

Browse files
j6tj6t
committed
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 <[email protected]>
2 parents ffe115e + 4e605b7 commit 148e914

File tree

1 file changed

+52
-22
lines changed

1 file changed

+52
-22
lines changed

‎gitk‎

Lines changed: 52 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ exec wish "$0" -- "$@"
77
# and distributed under the terms of the GNU General Public Licence,
88
# either version 2, or (at your option) any later version.
99

10-
if {[catch {package require Tcl 8.6-8.8} err]} {
10+
if {[catch {package require Tcl 8.6-} err]} {
1111
catch {wm withdraw .}
1212
tk_messageBox \
1313
-icon error \
@@ -33,6 +33,26 @@ The version of git found is $git_version."
3333
exit 1
3434
}
3535

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+
}
54+
}
55+
3656
######################################################################
3757
##
3858
## Enabling platform-specific code paths
@@ -2290,6 +2310,16 @@ proc bind_mousewheel {} {
22902310
bind $cflist <MouseWheel> {$cflist yview scroll [scrollval %D 2] units}
22912311
bind $cflist <Shift-MouseWheel> break
22922312
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+
}
22932323
}
22942324
22952325
proc bind_mousewheel_buttons {} {
@@ -2749,7 +2779,7 @@ proc makewindow {} {
27492779
bindall <1> {selcanvline %W %x %y}
27502780
27512781
#Mouse / touchpad scrolling
2752-
if {[tk windowingsystem] == "win32"} {
2782+
if {[tk windowingsystem] == "win32" || [package vcompare $::tcl_version 8.7] >= 0} {
27532783
set scroll_D0 120
27542784
bind_mousewheel
27552785
} elseif {[tk windowingsystem] == "x11"} {
@@ -7796,7 +7826,7 @@ proc gettree {id} {
77967826
set treepending $id
77977827
set treefilelist($id) {}
77987828
set treeidlist($id) {}
7799-
fconfigure $gtf -blocking 0 -encoding binary
7829+
fconfigure $gtf -blocking 0 -translation binary
78007830
filerun $gtf [list gettreeline $gtf $id]
78017831
}
78027832
} else {
@@ -7823,7 +7853,7 @@ proc gettreeline {gtf id} {
78237853
if {[string index $fname 0] eq "\""} {
78247854
set fname [lindex $fname 0]
78257855
}
7826-
set fname [encoding convertfrom utf-8 $fname]
7856+
set fname [convertfrom utf-8 $fname]
78277857
lappend treefilelist($id) $fname
78287858
}
78297859
if {![eof $gtf]} {
@@ -8057,7 +8087,7 @@ proc gettreediffs {ids} {
80578087
80588088
set treepending $ids
80598089
set treediff {}
8060-
fconfigure $gdtf -blocking 0 -encoding binary
8090+
fconfigure $gdtf -blocking 0 -translation binary
80618091
filerun $gdtf [list gettreediffline $gdtf $ids]
80628092
}
80638093
@@ -8083,7 +8113,7 @@ proc gettreediffline {gdtf ids} {
80838113
if {[string index $file 0] eq "\""} {
80848114
set file [lindex $file 0]
80858115
}
8086-
set file [encoding convertfrom utf-8 $file]
8116+
set file [convertfrom utf-8 $file]
80878117
if {$file ne [lindex $treediff end]} {
80888118
lappend treediff $file
80898119
lappend sublist $file
@@ -8168,7 +8198,7 @@ proc getblobdiffs {ids} {
81688198
error_popup [mc "Error getting diffs: %s" $err]
81698199
return
81708200
}
8171-
fconfigure $bdf -blocking 0 -encoding binary -eofchar {}
8201+
fconfigure $bdf -blocking 0 -translation binary
81728202
set blobdifffd($ids) $bdf
81738203
initblobdiffvars
81748204
filerun $bdf [list getblobdiffline $bdf $diffids]
@@ -8219,7 +8249,7 @@ proc makediffhdr {fname ids} {
82198249
global ctext curdiffstart treediffs diffencoding
82208250
global ctext_file_names jump_to_here targetline diffline
82218251
8222-
set fname [encoding convertfrom utf-8 $fname]
8252+
set fname [convertfrom utf-8 $fname]
82238253
set diffencoding [get_path_encoding $fname]
82248254
set i [lsearch -exact $treediffs($ids) $fname]
82258255
if {$i >= 0} {
@@ -8281,7 +8311,7 @@ proc parseblobdiffline {ids line} {
82818311
82828312
if {![string compare -length 5 "diff " $line]} {
82838313
if {![regexp {^diff (--cc|--git) } $line m type]} {
8284-
set line [encoding convertfrom utf-8 $line]
8314+
set line [convertfrom utf-8 $line]
82858315
$ctext insert end "$line\n" hunksep
82868316
continue
82878317
}
@@ -8330,7 +8360,7 @@ proc parseblobdiffline {ids line} {
83308360
makediffhdr $fname $ids
83318361
83328362
} 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]]
83348364
$ctext insert end "\n"
83358365
set curdiffstart [$ctext index "end - 1c"]
83368366
lappend ctext_file_names $fname
@@ -8343,7 +8373,7 @@ proc parseblobdiffline {ids line} {
83438373
83448374
} elseif {![string compare -length 2 "@@" $line]} {
83458375
regexp {^@@+} $line ats
8346-
set line [encoding convertfrom $diffencoding $line]
8376+
set line [convertfrom $diffencoding $line]
83478377
$ctext insert end "$line\n" hunksep
83488378
if {[regexp { \+(\d+),\d+ @@} $line m nl]} {
83498379
set diffline $nl
@@ -8372,18 +8402,18 @@ proc parseblobdiffline {ids line} {
83728402
$ctext insert end "$line\n" filesep
83738403
}
83748404
} elseif {$currdiffsubmod != "" && ![string compare -length 3 " >" $line]} {
8375-
set line [encoding convertfrom $diffencoding $line]
8405+
set line [convertfrom $diffencoding $line]
83768406
$ctext insert end "$line\n" dresult
83778407
} elseif {$currdiffsubmod != "" && ![string compare -length 3 " <" $line]} {
8378-
set line [encoding convertfrom $diffencoding $line]
8408+
set line [convertfrom $diffencoding $line]
83798409
$ctext insert end "$line\n" d0
83808410
} elseif {$diffinhdr} {
83818411
if {![string compare -length 12 "rename from " $line]} {
83828412
set fname [string range $line [expr 6 + [string first " from " $line] ] end]
83838413
if {[string index $fname 0] eq "\""} {
83848414
set fname [lindex $fname 0]
83858415
}
8386-
set fname [encoding convertfrom utf-8 $fname]
8416+
set fname [convertfrom utf-8 $fname]
83878417
set i [lsearch -exact $treediffs($ids) $fname]
83888418
if {$i >= 0} {
83898419
setinlist difffilestart $i $curdiffstart
@@ -8402,12 +8432,12 @@ proc parseblobdiffline {ids line} {
84028432
set diffinhdr 0
84038433
return
84048434
}
8405-
set line [encoding convertfrom utf-8 $line]
8435+
set line [convertfrom utf-8 $line]
84068436
$ctext insert end "$line\n" filesep
84078437
84088438
} else {
84098439
set line [string map {\x1A ^Z} \
8410-
[encoding convertfrom $diffencoding $line]]
8440+
[convertfrom $diffencoding $line]]
84118441
# parse the prefix - one ' ', '-' or '+' for each parent
84128442
set prefix [string range $line 0 [expr {$diffnparents - 1}]]
84138443
set tag [expr {$diffnparents > 1? "m": "d"}]
@@ -12348,7 +12378,7 @@ proc cache_gitattr {attr pathlist} {
1234812378
foreach row [split $rlist "\n"] {
1234912379
if {[regexp "(.*): $attr: (.*)" $row m path value]} {
1235012380
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]]
1235212382
}
1235312383
set path_attr_cache($attr,$path) $value
1235412384
}
@@ -12581,14 +12611,14 @@ catch {
1258112611
set config_file_tmp [file join $env(XDG_CONFIG_HOME) git gitk-tmp]
1258212612
} else {
1258312613
# 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"
1258612616
}
1258712617
if {![file exists $config_file]} {
1258812618
# 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"
1259212622
} elseif {![file exists [file dirname $config_file]]} {
1259312623
file mkdir [file dirname $config_file]
1259412624
}

0 commit comments

Comments
 (0)