Skip to content

Add tcl9.0 compatibility #15

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 9 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
46 changes: 33 additions & 13 deletions git-gui.sh
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ along with this program; if not, see <https://www.gnu.org/licenses/>.}]
##
## Tcl/Tk sanity check

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 \
Expand Down Expand Up @@ -73,6 +73,26 @@ proc is_Cygwin {} {
return $_iscygwin
}

######################################################################
## 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
}
proc convertfrom args {
return [encoding convertfrom -profile tcl8 {*}$args]
}
} else {
proc convertfrom args {
return [encoding convertfrom {*}$args]
}
}

######################################################################
##
## PATH lookup. Sanitize $PATH, assure exec/open use only that
Expand Down Expand Up @@ -183,7 +203,9 @@ if {[is_Windows]} {
set command_line [string trim [string range $arg0 1 end]]
lset args 0 "| [sanitize_command_line $command_line 0]"
}
uplevel 1 real_open $args
set fd [real_open {*}$args]
fconfigure $fd -eofchar {}
return $fd
}

} else {
Expand Down Expand Up @@ -590,7 +612,7 @@ proc git {args} {

proc git_redir {cmd redir} {
set fd [git_read $cmd $redir]
fconfigure $fd -translation binary -encoding utf-8
fconfigure $fd -encoding utf-8
set result [string trimright [read $fd] "\n"]
close $fd
if {$::_trace} {
Expand All @@ -607,7 +629,6 @@ proc safe_open_command {cmd {redir {}}} {
} err]} {
error $err
}
fconfigure $fd -eofchar {}
return $fd
}

Expand Down Expand Up @@ -1003,7 +1024,7 @@ proc _parse_config {arr_name args} {
[concat config \
$args \
--null --list]]
fconfigure $fd_rc -translation binary -encoding utf-8
fconfigure $fd_rc -encoding utf-8
set buf [read $fd_rc]
close $fd_rc
}
Expand Down Expand Up @@ -1405,15 +1426,15 @@ proc rescan_stage2 {fd after} {
set fd_di [git_read [list diff-index --cached --ignore-submodules=dirty -z [PARENT]]]
set fd_df [git_read [list diff-files -z]]

fconfigure $fd_di -blocking 0 -translation binary -encoding binary
fconfigure $fd_df -blocking 0 -translation binary -encoding binary
fconfigure $fd_di -blocking 0 -translation binary
fconfigure $fd_df -blocking 0 -translation binary

fileevent $fd_di readable [list read_diff_index $fd_di $after]
fileevent $fd_df readable [list read_diff_files $fd_df $after]

if {[is_config_true gui.displayuntracked]} {
set fd_lo [git_read [concat ls-files --others -z $ls_others]]
fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
fconfigure $fd_lo -blocking 0 -translation binary
fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
incr rescan_active
}
Expand All @@ -1427,7 +1448,6 @@ proc load_message {file {encoding {}}} {
if {[catch {set fd [safe_open_file $f r]}]} {
return 0
}
fconfigure $fd -eofchar {}
if {$encoding ne {}} {
fconfigure $fd -encoding $encoding
}
Expand Down Expand Up @@ -1484,7 +1504,7 @@ proc run_prepare_commit_msg_hook {} {
ui_status [mc "Calling prepare-commit-msg hook..."]
set pch_error {}

fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
fconfigure $fd_ph -blocking 0 -translation binary
fileevent $fd_ph readable \
[list prepare_commit_msg_hook_wait $fd_ph]

Expand Down Expand Up @@ -1530,7 +1550,7 @@ proc read_diff_index {fd after} {
set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
merge_state \
[encoding convertfrom utf-8 $p] \
[convertfrom utf-8 $p] \
[lindex $i 4]? \
[list [lindex $i 0] [lindex $i 2]] \
[list]
Expand Down Expand Up @@ -1563,7 +1583,7 @@ proc read_diff_files {fd after} {
set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
merge_state \
[encoding convertfrom utf-8 $p] \
[convertfrom utf-8 $p] \
?[lindex $i 4] \
[list] \
[list [lindex $i 0] [lindex $i 2]]
Expand All @@ -1586,7 +1606,7 @@ proc read_ls_others {fd after} {
set pck [split $buf_rlo "\0"]
set buf_rlo [lindex $pck end]
foreach p [lrange $pck 0 end-1] {
set p [encoding convertfrom utf-8 $p]
set p [convertfrom utf-8 $p]
if {[string index $p end] eq {/}} {
set p [string range $p 0 end-1]
}
Expand Down
9 changes: 3 additions & 6 deletions lib/blame.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -483,7 +483,6 @@ method _load {jump} {
} else {
set fd [safe_open_file $path r]
}
fconfigure $fd -eofchar {}
} else {
if {$do_textconv ne 0} {
set fd [git_read [list cat-file --textconv "$commit:$path"]]
Expand All @@ -493,7 +492,6 @@ method _load {jump} {
}
fconfigure $fd \
-blocking 0 \
-translation lf \
-encoding [get_path_encoding $path]
fileevent $fd readable [cb _read_file $fd $jump]
set current_fd $fd
Expand Down Expand Up @@ -620,7 +618,7 @@ method _exec_blame {cur_w cur_d options cur_s} {

lappend options -- $path
set fd [git_read_nice [concat blame $options]]
fconfigure $fd -blocking 0 -translation lf -encoding utf-8
fconfigure $fd -blocking 0 -encoding utf-8
fileevent $fd readable [cb _read_blame $fd $cur_w $cur_d]
set current_fd $fd
set blame_lines 0
Expand Down Expand Up @@ -986,7 +984,7 @@ method _showcommit {cur_w lno} {
set msg {}
catch {
set fd [git_read [list cat-file commit $cmit]]
fconfigure $fd -encoding binary -translation lf
fconfigure $fd -encoding iso8859-1
# By default commits are assumed to be in utf-8
set enc utf-8
while {[gets $fd line] > 0} {
Expand All @@ -999,7 +997,7 @@ method _showcommit {cur_w lno} {

set enc [tcl_encoding $enc]
if {$enc ne {}} {
set msg [encoding convertfrom $enc $msg]
set msg [convertfrom $enc $msg]
}
set msg [string trim $msg]
}
Expand Down Expand Up @@ -1143,7 +1141,6 @@ method _blameparent {} {

fconfigure $fd \
-blocking 0 \
-encoding binary \
-translation binary
fileevent $fd readable [cb _read_diff_load_commit \
$fd $cparent $new_path $r_orig_line]
Expand Down
4 changes: 2 additions & 2 deletions lib/branch.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ proc load_all_heads {} {
set rh_len [expr {[string length $rh] + 1}]
set all_heads [list]
set fd [git_read [list for-each-ref --format=%(refname) $rh]]
fconfigure $fd -translation binary -encoding utf-8
fconfigure $fd -encoding utf-8
while {[gets $fd line] > 0} {
if {!$some_heads_tracking || ![is_tracking_branch $line]} {
lappend all_heads [string range $line $rh_len end]
Expand All @@ -25,7 +25,7 @@ proc load_all_tags {} {
--sort=-taggerdate \
--format=%(refname) \
refs/tags]]
fconfigure $fd -translation binary -encoding utf-8
fconfigure $fd -encoding utf-8
while {[gets $fd line] > 0} {
if {![regsub ^refs/tags/ $line {} name]} continue
lappend all_tags $name
Expand Down
2 changes: 1 addition & 1 deletion lib/browser.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -195,7 +195,7 @@ method _ls {tree_id {name {}}} {
$w conf -state disabled

set fd [git_read [list ls-tree -z $tree_id]]
fconfigure $fd -blocking 0 -translation binary -encoding utf-8
fconfigure $fd -blocking 0 -encoding utf-8
fileevent $fd readable [cb _read $fd]
}

Expand Down
2 changes: 1 addition & 1 deletion lib/checkout_op.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -462,7 +462,7 @@ If you wanted to be on a branch, create one now starting from 'This Detached Che
if {$fd_ph ne {}} {
global pch_error
set pch_error {}
fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
fconfigure $fd_ph -blocking 0 -translation binary
fileevent $fd_ph readable [cb _postcheckout_wait $fd_ph]
} else {
_update_repo_state $this
Expand Down
4 changes: 2 additions & 2 deletions lib/choose_rev.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -147,7 +147,7 @@ constructor _new {path unmerged_only title} {
refs/remotes \
refs/tags \
]]
fconfigure $fr_fd -translation lf -encoding utf-8
fconfigure $fr_fd -encoding utf-8
while {[gets $fr_fd line] > 0} {
set line [eval $line]
if {[lindex $line 1 0] eq {tag}} {
Expand Down Expand Up @@ -570,7 +570,7 @@ method _reflog_last {name} {
set last {}
if {[catch {set last [file mtime [gitdir $name]]}]
&& ![catch {set g [safe_open_file [gitdir logs $name] r]}]} {
fconfigure $g -translation binary
fconfigure $g -encoding iso8859-1
while {[gets $g line] >= 0} {
if {[regexp {> ([1-9][0-9]*) } $line line when]} {
set last $when
Expand Down
16 changes: 8 additions & 8 deletions lib/commit.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,7 @@ You are currently in the middle of a merge that has not been fully completed. Y
set name ""
set email ""
set fd [git_read [list cat-file commit $curHEAD]]
fconfigure $fd -encoding binary -translation lf
fconfigure $fd -encoding iso8859-1
# By default commits are assumed to be in utf-8
set enc utf-8
while {[gets $fd line] > 0} {
Expand All @@ -43,9 +43,9 @@ You are currently in the middle of a merge that has not been fully completed. Y

set enc [tcl_encoding $enc]
if {$enc ne {}} {
set msg [encoding convertfrom $enc $msg]
set name [encoding convertfrom $enc $name]
set email [encoding convertfrom $enc $email]
set msg [convertfrom $enc $msg]
set name [convertfrom $enc $name]
set email [convertfrom $enc $email]
}
if {$name ne {} && $email ne {}} {
set commit_author [list name $name email $email date $time]
Expand Down Expand Up @@ -252,7 +252,7 @@ A good commit message has the following format:

ui_status [mc "Calling pre-commit hook..."]
set pch_error {}
fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
fconfigure $fd_ph -blocking 0 -translation binary
fileevent $fd_ph readable \
[list commit_prehook_wait $fd_ph $curHEAD $msg_p]
}
Expand Down Expand Up @@ -307,7 +307,7 @@ Do you really want to proceed with your Commit?"]

ui_status [mc "Calling commit-msg hook..."]
set pch_error {}
fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
fconfigure $fd_ph -blocking 0 -translation binary
fileevent $fd_ph readable \
[list commit_commitmsg_wait $fd_ph $curHEAD $msg_p]
}
Expand Down Expand Up @@ -361,7 +361,7 @@ proc commit_committree {fd_wt curHEAD msg_p} {
#
if {$commit_type eq {normal}} {
set fd_ot [git_read [list cat-file commit $PARENT]]
fconfigure $fd_ot -encoding binary -translation lf
fconfigure $fd_ot -encoding iso8859-1
set old_tree [gets $fd_ot]
close $fd_ot

Expand Down Expand Up @@ -460,7 +460,7 @@ A rescan will be automatically started now.
if {$fd_ph ne {}} {
global pch_error
set pch_error {}
fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
fconfigure $fd_ph -blocking 0 -translation binary
fileevent $fd_ph readable \
[list commit_postcommit_wait $fd_ph $cmt_id]
}
Expand Down
3 changes: 2 additions & 1 deletion lib/diff.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -191,7 +191,6 @@ proc show_other_diff {path w m cont_info} {
file {
set fd [safe_open_file $path r]
fconfigure $fd \
-eofchar {} \
-encoding [get_path_encoding $path]
set content [read $fd $max_sz]
close $fd
Expand Down Expand Up @@ -325,6 +324,8 @@ proc start_show_diff {cont_info {add_opts {}}} {
# '++' lines which is not bijective. Thus, we need to maintain a state
# across lines.
set ::conflict_in_pre_image 0

# git-diff has eol==\n, \r if present is part of the text
fconfigure $fd \
-blocking 0 \
-encoding [get_path_encoding $path] \
Expand Down
3 changes: 0 additions & 3 deletions lib/index.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,6 @@ proc update_indexinfo {msg path_list after} {
-blocking 0 \
-buffering full \
-buffersize 512 \
-encoding binary \
-translation binary
fileevent $fd writable [list \
write_update_indexinfo \
Expand Down Expand Up @@ -147,7 +146,6 @@ proc update_index {msg path_list after} {
-blocking 0 \
-buffering full \
-buffersize 512 \
-encoding binary \
-translation binary
fileevent $fd writable [list \
write_update_index \
Expand Down Expand Up @@ -227,7 +225,6 @@ proc checkout_index {msg path_list after capture_error} {
-blocking 0 \
-buffering full \
-buffersize 512 \
-encoding binary \
-translation binary
fileevent $fd writable [list \
write_checkout_index \
Expand Down
4 changes: 2 additions & 2 deletions lib/mergetool.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ proc merge_load_stages {path cont} {

set merge_stages_fd [git_read [list ls-files -u -z -- $path]]

fconfigure $merge_stages_fd -blocking 0 -translation binary -encoding binary
fconfigure $merge_stages_fd -blocking 0 -translation binary
fileevent $merge_stages_fd readable [list read_merge_stages $merge_stages_fd $cont]
}

Expand Down Expand Up @@ -370,7 +370,7 @@ proc merge_tool_start {cmdline target backup stages} {

ui_status [mc "Running merge tool..."]

fconfigure $mtool_fd -blocking 0 -translation binary -encoding binary
fconfigure $mtool_fd -blocking 0 -translation binary
fileevent $mtool_fd readable [list read_mtool_output $mtool_fd]
}

Expand Down
1 change: 0 additions & 1 deletion lib/remote_branch_delete.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -307,7 +307,6 @@ method _load {cache uri} {
set active_ls [git_read [list ls-remote $uri]]
fconfigure $active_ls \
-blocking 0 \
-translation lf \
-encoding utf-8
fileevent $active_ls readable [cb _read $cache $active_ls]
} else {
Expand Down
1 change: 0 additions & 1 deletion lib/spellcheck.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,6 @@ constructor init {pipe_fd ui_text ui_menu} {
method _connect {pipe_fd} {
fconfigure $pipe_fd \
-encoding utf-8 \
-eofchar {} \
-translation lf

if {[gets $pipe_fd s_version] <= 0} {
Expand Down
8 changes: 4 additions & 4 deletions lib/themed.tcl
Original file line number Diff line number Diff line change
Expand Up @@ -21,10 +21,10 @@ namespace eval color {
set inactive_select_bg [convert_rgb_to_gray $select_bg]
set inactive_select_fg $select_fg

set color::select_bg $select_bg
set color::select_fg $select_fg
set color::inactive_select_bg $inactive_select_bg
set color::inactive_select_fg $inactive_select_fg
set ::color::select_bg $select_bg
set ::color::select_fg $select_fg
set ::color::inactive_select_bg $inactive_select_bg
set ::color::inactive_select_fg $inactive_select_fg

proc add_option {key val} {
option add $key $val widgetDefault
Expand Down