Merge branch 'ml/tcl90'

* ml/tcl90:
  git-gui: Allow Tcl 9.0
  git-gui: use -profile tcl8 on encoding conversions
  git-gui: use -profile tcl8 for file input with Tcl 9
  git-gui: themed.tcl: use full namespace for color
  git-gui: remove EOL translation for gets
  git-gui: do not mix -translation binary and -encoding
  git-gui: replace encoding binary with iso8859-1
  git-gui: translation binary defines iso8859-1
  git-gui: assure -eofchar {} on all channels

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

Author: j6t

git-gui.sh

@@ -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 \
@@ -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
@@ -177,7 +197,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 {
@@ -582,7 +604,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} {
@@ -599,7 +621,6 @@ proc safe_open_command {cmd {redir {}}} {
 	} err]} {
 		error $err
 	}
-	fconfigure $fd -eofchar {}
 	return $fd
 }
 
@@ -995,7 +1016,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
 	}
@@ -1397,15 +1418,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
 	}
@@ -1419,7 +1440,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
 		}
@@ -1476,7 +1496,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]
 
@@ -1522,7 +1542,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]
@@ -1555,7 +1575,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]]
@@ -1578,7 +1598,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]
 		}

lib/blame.tcl

@@ -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"]]
@@ -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
@@ -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
@@ -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} {
@@ -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]
 			}
@@ -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]

lib/branch.tcl

@@ -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]
@@ -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

lib/browser.tcl

@@ -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]
 }
 

lib/checkout_op.tcl

@@ -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

lib/choose_rev.tcl

@@ -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}} {
@@ -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

lib/commit.tcl

@@ -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} {
@@ -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]
@@ -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]
 }
@@ -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]
 }
@@ -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
 
@@ -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]
 	}

lib/diff.tcl

@@ -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
@@ -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] \

lib/index.tcl

@@ -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 \
@@ -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 \
@@ -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 \

lib/mergetool.tcl

@@ -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]
 }
 
@@ -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]
 }