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
EKB May 8, 2005 -- I've used the "encsource" proc to read in user-created input files. The input files are in Tcl, and the user might write them in any encoding. To allow for any possible encoding, I allow the user to start the file with an "encoding directive" that looks something like
#ENC cp1252The encoding directive has to be the first line of the file. When the file is read, it is first opened in the default encoding and the first line is scanned. If it is an encoding directive, the encoding is set using it, the file is closed, and then reopened using the proper encoding. (This is how web browsers do it -- the characters to specify the encoding should be readable in the default encoding, even if the rest of the file isn't.)Here's the code I use to do this (the variable defcharset is set to a default encoding and the variable encdir is set to the path that holds the encoding files -- this shouldn't be needed if the user has Tcl/Tk installed, but I distribute this as a freewrapped application):
# Find out if there is an encoding directive
set charset $defcharset
if {[catch {open $currfnamefull r} fhndl]} {
tk_messageBox -icon error -message "Couldn't open script \"$currfname\": $fhndl"
return
} else {
set firstline [gets $fhndl]
if {[regexp -- "^#ENC\\s+\(\\S+\)$" $firstline wholeline enc] == 1} {
set charset [file join $encdir $enc]
}
close $fhndl
}
if [catch {encsource $tempfname $charset} err] {
# Error - take action
} else {
# All is well!
}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