For those having source files containing data not encoded in the system encoding (and thus being not recognized correct by source), this small helper proc may help you:
---
proc encsource {source_file encoding} {
if {![catch {open $source_file r} fid]} {
if {![catch {fconfigure $fid -encoding $encoding} msg]} {
set script [read $fid]
catch {close $fid}
} else {
# make sure channel gets closed
catch {close $fid}
return -code error "unknown encoding \"$encoding\""
}
} else {
# return error message similar to source cmd
return -code error "couldn't read file \"$source_file\": no such file or directory"
}
# not sure if this has to be catched as well to propagate the error code to the caller
# to imitate the original source cmds behaviour.
uplevel 1 $script
}---
Usage: % encsource "test.tcl" utf-8
Peter K: I had to develop Tcl code for Windows (shudder) and used existing code on the Mac. Since I had to do a lot of transferring between Mac and cp1252, I wrote a little script to convert files and folders between all possible encodings. Here is the code (encoded in cp1252):
#############################################################################
# Visual Tcl v1.20 Project
#
#################################
# GLOBAL VARIABLES
#
global Kodierung ; set Kodierung 3
global Kodierung1 ; set Kodierung1 cp1252
global Kodierung2 ; set Kodierung2 macRoman
global Eingabe ; set Eingabe ""
global Ausgabe ; set Ausgabe ""
global Auswahl ; set Auswahl [encoding names]
#################################
# USER DEFINED PROCEDURES
#
proc {main} {argc argv} {
}
#
#
#
proc {Window} {args} {
#
set cmd [lindex $args 0]
set name [lindex $args 1]
set newname [lindex $args 2]
set rest [lrange $args 3 end]
if {$name == "" || $cmd == ""} {return}
if {$newname == ""} {
set newname $name
}
set exists [winfo exists $newname]
switch $cmd {
show {
if {$exists == "1" && $name != "."} {wm deiconify $name; return}
if {[info procs vTclWindow(pre)$name] != ""} {
eval "vTclWindow(pre)$name $newname $rest"
}
if {[info procs vTclWindow$name] != ""} {
eval "vTclWindow$name $newname $rest"
}
if {[info procs vTclWindow(post)$name] != ""} {
eval "vTclWindow(post)$name $newname $rest"
}
}
hide { if $exists {wm withdraw $newname; return} }
iconify { if $exists {wm iconify $newname; return} }
destroy { if $exists {destroy $newname; return} }
}
}
#################################
# VTCL GENERATED GUI PROCEDURES
#
proc vTclWindow. {base} {
if {$base == ""} {
set base .
}
###################
# CREATING WIDGETS
###################
wm focusmodel $base passive
wm geometry $base 1x1+25+65
wm maxsize $base 817 594
wm minsize $base 1 1
wm overrideredirect $base 0
wm resizable $base 1 1
wm withdraw $base
wm title $base "Wish"
###################
# SETTING GEOMETRY
###################
}
proc vTclWindow.dialog {base} {
global Kodierung
global Kodierung1
global Kodierung2
global Eingabe
global Ausgabe
global Auswahl
#
if {$base == ""} {
set base .dialog
}
if {[winfo exists $base]} {
wm deiconify $base; return
}
###################
# CREATING WIDGETS
###################
toplevel $base -class Toplevel -relief groove
wm focusmodel $base passive
wm geometry $base 417x338+101+123
wm maxsize $base 817 594
wm minsize $base 1 1
wm overrideredirect $base 0
wm resizable $base 1 1
wm deiconify $base
wm title $base "Translate Encodings"
set Verschiebung 1
#
frame $base.eingabe \
-borderwidth 1 -height 30 -relief ridge -width 30
entry $base.eingabe.03 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \
-textvariable Eingabe -justify center -width 8 -state normal
button $base.such1 -text "Source File:" \
-command "Datei_lesen" -height 28
button $base.such2 -text "Source Directory:" \
-command "Verzeichnis_lesen" -height 28
#
# Das Aufklapp-MenŸ anlegen
#
menubutton $base.m1 \
-menu $base.m1.sub -textvariable Kodierung1 -direction flush \
-borderwidth 2 -indicatoron 1 -padx 8
menu $base.m1.sub -tearoff 0
foreach Eintrag $Auswahl {
$base.m1.sub add radiobutton \
-variable Kodierung1 -value $Eintrag -label $Eintrag
}
radiobutton $base.b0 \
-text "MacRoman -> iso8859-1" -cursor left_ptr -anchor w \
-variable Kodierung -value 0 \
-command {set Kodierung1 MacRoman; set Kodierung2 iso8859-1}
radiobutton $base.b1 \
-text "iso8859-1 -> MacRoman" -cursor left_ptr -anchor w \
-variable Kodierung -value 1 \
-command {set Kodierung1 iso8859-1; set Kodierung2 MacRoman}
radiobutton $base.b2 \
-text "MacRoman -> cp1252" -cursor left_ptr -anchor w \
-variable Kodierung -value 2 \
-command {set Kodierung1 MacRoman; set Kodierung2 cp1252}
radiobutton $base.b3 \
-text "cp1252 -> MacRoman" -cursor left_ptr -anchor w \
-variable Kodierung -value 3 \
-command {set Kodierung1 cp1252; set Kodierung2 MacRoman}
menubutton $base.m2 \
-menu $base.m2.sub -textvariable Kodierung2 -direction flush \
-borderwidth 2 -indicatoron 1 -padx 8
menu $base.m2.sub -tearoff 0
foreach Eintrag $Auswahl {
$base.m2.sub add radiobutton \
-variable Kodierung2 -value $Eintrag -label $Eintrag
}
#
frame $base.ausgabe \
-borderwidth 1 -height 30 -relief ridge -width 30
entry $base.ausgabe.03 \
-font -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* \
-textvariable Ausgabe -justify center -width 8 -state disabled
button $base.such3 -text "Target File:" \
-command "Datei_schreiben" -height 28
button $base.such4 -text "Target Directory:" \
-command "Verzeichnis_schreiben" -height 28
message $base.m -width 377 \
-text "Warning: Files will be overwritten without warning!"
bind $base <Return> {Schreiben $Ausgabe}
###################
# SETTING GEOMETRY
###################
place $base.eingabe \
-x 5 -y 45 -width 408 -height 36
grid columnconf $base.eingabe 0 -weight 1
grid rowconf $base.eingabe 0 -weight 1
grid $base.eingabe.03 \
-column 0 -row 0 -columnspan 1 -rowspan 1 -sticky nesw
place $base.such1 \
-x 10 -y 16 -width 190 -height 28
place $base.such2 \
-x 220 -y 16 -width 190 -height 28
place $base.m1 \
-x 20 -y 95 -width 320 -height 29
place $base.b0 \
-x 20 -y 138 -anchor w
place $base.b1 \
-x 210 -y 138 -anchor w
place $base.b2 \
-x 20 -y 168 -anchor w
place $base.b3 \
-x 210 -y 168 -anchor w
place $base.m2 \
-x 20 -y 185 -width 320 -height 29
place $base.ausgabe \
-x 5 -y 255 -width 408 -height 36
grid columnconf $base.ausgabe 0 -weight 1
grid rowconf $base.ausgabe 0 -weight 1
grid $base.ausgabe.03 \
-column 0 -row 0 -columnspan 1 -rowspan 1 -sticky nesw
place $base.such3 \
-x 10 -y 226 -width 190 -height 28
place $base.such4 \
-x 220 -y 226 -width 190 -height 28
place $base.m \
-x 20 -y 310 -anchor w
}
#
#
#
proc fileDialog { w ent operation art } {
global Namen
# Type names Extension(s) Mac File Type(s)
#
#---------------------------------------------------------
set types {
{"All files" * }
{"Text files" {} TEXT}
{"Text files" {.txt} }
}
if {$operation == "open"} {
set file [tk_getOpenFile -filetypes $types -parent $w]
} elseif {$operation == "viele"} {
set file [tk_chooseDirectory -parent $w]
} elseif {$operation == "save"} {
set file [tk_getSaveFile -parent $w -initialfile $Namen]
} else {
set file [tk_chooseDirectory -parent $w]
}
if [string compare $file ""] {
if {$art == "entry"} {
$ent delete 0 end
$ent insert 0 "$file"
$ent xview end
} else {
set file [join [list $art Datei] {}]
}
}
return $file
}
#
#
#
proc Datei_lesen {} {
global Eingabe
global Namen
#
set Eingabe "[fileDialog .dialog .dialog.eingabe.03 open entry]"
Einlesen
set Namen [file tail $Eingabe]
update
}
#
#
#
proc Verzeichnis_lesen {} {
global Dateiliste
#
set Eingabe "[fileDialog .dialog .dialog.eingabe.03 viele entry]"
set Liste [glob -nocomplain [file join $Eingabe "*"]]
set Dateiliste {}
foreach f $Liste {
if { ![file isdirectory $f] } {
lappend Dateiliste $f
}
}
}
#
#
#
proc Datei_schreiben {} {
global Ausgabe
global tcl_platform
#
set Ausgabe "[fileDialog .dialog .dialog.ausgabe.03 save entry]"
Schreiben
if {$tcl_platform(platform) == "macintosh"} {
file attributes $Ausgabe -creator "ALFA" -type "TEXT"
}
}
#
#
#
proc Verzeichnis_schreiben {} {
global Eingabe
global Ausgabe
global Dateiliste
global tcl_platform
#
set Ziel "[fileDialog .dialog .dialog.ausgabe.03 viele entry]"
foreach f $Dateiliste {
set Eingabe $f
Einlesen
set Namen [file tail $Eingabe]
set Ausgabe [file join $Ziel $Namen]
Schreiben
if {$tcl_platform(platform) == "macintosh"} {
file attributes $Ausgabe -creator "ALFA" -type "TEXT"
}
}
}
#
#
#
proc Einlesen {} {
global Kodierung1
global Eingabe
global Datei
#
encoding system $Kodierung1
#
if [catch {open "$Eingabe" r} fileID] {
tk_messageBox .error -title "Fehler beim …ffnen der Datei" \
-message "Datei $Eingabe geht nicht auf" -icon error -type ok
} else {
set Datei [split [read $fileID] \n]
close $fileID
}
}
#
#
#
proc Schreiben {} {
global Kodierung2
global Ausgabe
global Datei
#
encoding system $Kodierung2
#
if [catch {open "$Ausgabe" w} fileID] {
tk_messageBox .error -title "Fehler beim …ffnen der Datei" \
-message "Datei $Ausgabe geht nicht auf" -icon error -type ok
} else {
foreach Zeile $Datei {
puts $fileID $Zeile
}
close $fileID
}
}
Window show .
Window show .dialog
console hide
main $argc $argv