# $Id: idnconf.tcl,v 1.1 2003/06/04 00:27:42 marka Exp $
#
# idnconf.tcl - configure idn wrapper
#
#############################################################################
# Copyright (c) 2000,2002 Japan Network Information Center.
# All rights reserved.
#
# By using this file, you agree to the terms and conditions set forth bellow.
#
# LICENSE TERMS AND CONDITIONS
#
# The following License Terms and Conditions apply, unless a different
# license is obtained from Japan Network Information Center ("JPNIC"),
# a Japanese association, Kokusai-Kougyou-Kanda Bldg 6F, 2-3-4 Uchi-Kanda,
# Chiyoda-ku, Tokyo 101-0047, Japan.
#
# 1. Use, Modification and Redistribution (including distribution of any
# modified or derived work) in source and/or binary forms is permitted
# under this License Terms and Conditions.
#
# 2. Redistribution of source code must retain the copyright notices as they
# appear in each source code file, this License Terms and Conditions.
#
# 3. Redistribution in binary form must reproduce the Copyright Notice,
# this License Terms and Conditions, in the documentation and/or other
# materials provided with the distribution. For the purposes of binary
# distribution the "Copyright Notice" refers to the following language:
# "Copyright (c) 2000-2002 Japan Network Information Center. All rights reserved."
#
# 4. The name of JPNIC may not be used to endorse or promote products
# derived from this Software without specific prior written approval of
# JPNIC.
#
# 5. Disclaimer/Limitation of Liability: THIS SOFTWARE IS PROVIDED BY JPNIC
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL JPNIC BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
#############################################################################
global configFile configBack
global registryKey registryEnc registryDef
global filesCpy filesRen filesDel
# idnkit version
set version "1.0"
set configFile "idnconf.lst" ;# list of wrapped program
set configBack "idnconf.bak" ;# backup of previous data
set serverKey "HKEY_LOCAL_MACHINE\\Software\\JPNIC\\IDN"
set serverLogLevel LogLevel
set serverLogLevelDef -1
set serverLogLevelNone -1
set serverLogFile LogFile
set serverLogFileDef {C:\idn_wrapper.log}
set serverConfFile ConfFile
set perprogKey "HKEY_LOCAL_MACHINE\\Software\\JPNIC\\IDN\\PerProg\\"
set perprogEnc Encoding
set perprogDef Default
set logFileNameDef idn_wrapper.log
set confFileNameDef idn.conf
set filesCpy11 { "wsock32.dll" }
set filesCpy20 { "wsock32.dll" "ws2_32.dll" }
set filesDel11 { "wsock32.dll" }
set filesDel20 { "wsock32.dll" "ws2_32.dll" }
set local_dll 0
########################################################################
#
# OS version check
#
proc get_os_version {} {
global os_version tcl_platform
if {[llength [info globals os_version]] > 0} {
return $os_version
}
switch -- $tcl_platform(os) {
"Windows 95" {
switch -- $tcl_platform(osVersion) {
4.0 {
set os_version {Windows 95}
}
4.10 {
set os_version {Windows 98}
}
4.90 {
set os_version {Windows Me}
}
}
}
"Windows NT" {
switch -- $tcl_platform(osVersion) {
3.51 -
4.0 {
set os_version {Windows NT}
}
5.0 {
set os_version {Windows 2000}
}
default {
# XP or .NET
set os_version {Windows XP}
}
}
}
"Win32s" {
error "idn wrapper does not support Windows 3.1"
}
default {
set os_version "Unknown"
}
}
set os_version
}
proc support_dll_redirection {} {
global dll_redirection
if {[llength [info globals dll_redirection]] > 0} {
return $dll_redirection
}
switch -- [get_os_version] {
{Windows 95} -
{Windows NT} {
# cannot force local DLL reference by .local file.
set dll_redirection 0
}
default {
set dll_redirection 1
}
}
set dll_redirection
}
########################################################################
#
# handling pathname
#
proc getExeName { prg } {
set elem [file split $prg]
set leng [expr {[llength $elem] - 1}]
set name [lindex $elem $leng]
set exe [file rootname $name]
return $exe
}
proc getDirName { prg } {
file dirname $prg
}
proc getSystemDir {} {
global env
switch -- [get_os_version] {
"Windows 95" -
"Windows 98" -
"Windows Me" {
set sysDir $env(windir)/system
}
default {
set sysDir $env(SystemRoot)/system32
}
}
return $sysDir
}
########################################################################
#
# loadList / saveList
#
# loadList - load list of wrapped executables from $configFile
# saveList - save list of wrapped executables into $configFile
#
proc loadList {} {
global configFile configBack
if { [file exists $configFile] } {
file copy -force $configFile $configBack
}
set aList {}
set fd [open $configFile {CREAT RDONLY}]
while { ! [eof $fd]} {
set line [gets $fd]
if { [string length $line] > 0} {
lappend aList "$line"
}
}
close $fd
return $aList
}
proc saveList { aList } {
global configFile
file delete -force $configFile
set fd [open $configFile {CREAT WRONLY}]
foreach e $aList {
puts $fd $e
}
close $fd
}
########################################################################
#
# putList / getList - set/get list to/from listbox
#
proc putList { lb aList } {
foreach e $aList {
$lb insert end $e
}
}
proc getList { lb } {
$lb get 0 end
}
########################################################################
#
# checkList / appendList / deleteList - check / append / delete program from/to listbox
#
proc checkList { lb prg } {
set cnt 0
set lst [getList $lb]
foreach n $lst {
if { [string compare $prg $n] == 0 } {
incr cnt
}
}
return $cnt
}
proc appendList { lb prg } {
if { [checkList $lb $prg] == 0 } {
$lb insert end $prg
}
}
proc deleteList { lb prg } {
set cnt 0
set lst [getList $lb]
foreach n $lst {
if { [string compare $n $prg] == 0 } {
$lb delete $cnt
}
incr cnt
}
}
########################################################################
#
# registry operations
#
proc regGetEncode { prg } {
global perprogKey perprogEnc perprogDef
if { [string compare $prg "" ] == 0 } {
return $perprogDef
}
if {![isWindows]} {
return $perprogDef
}
package require registry 1.0
set name [getExeName $prg]
set key $perprogKey$name
if { [catch {set enc [registry get $key $perprogEnc]} err] } {
return $perprogDef
}
if { [string compare $enc ""] == 0 } {
return $perprogDef
}
return $enc
}
proc regSetEncode { prg enc } {
global perprogKey perprogEnc perprogDef
if {![isWindows]} {
return 1
}
package require registry 1.0
set name [getExeName $prg]
set key $perprogKey$name
if { [string compare $enc $perprogDef] == 0 } {
set enc ""
}
if { [catch {registry set $key $perprogEnc $enc sz} ] } {
return 2
}
return 0
}
proc regGetLogLevel {} {
global serverKey serverLogLevel serverLogLevelDef
regGetValue $serverKey $serverLogLevel $serverLogLevelDef
}
proc regSetLogLevel {level} {
global serverKey serverLogLevel
regSetValue $serverKey $serverLogLevel $level dword
}
proc regGetLogFile {} {
global serverKey serverLogFile serverLogFileDef
set file [regGetValue $serverKey $serverLogFile $serverLogFileDef]
if {[catch {file attributes $file -longname} lfile]} {
# Maybe $file doesn't exist (yet). Get the longname of
# directory portion.
set dir [file dirname $file]
if {[catch {file attributes $dir -longname} ldir]} {
set ldir $dir
}
set lfile [file join $ldir [file tail $file]]
}
file nativename $lfile
}
proc regSetLogFile {file} {
global serverKey serverLogFile
regSetValue $serverKey $serverLogFile [file nativename $file]
}
proc regGetConfFile {} {
global serverKey serverConfFile
set file [regGetValue $serverKey $serverConfFile {}]
if {[string compare $file {}] == 0} {
return {}
}
if {[catch {file attributes $file -longname} lfile]} {
# Maybe $file doesn't exist (yet). Get the longname of
# directory portion.
set dir [file dirname $file]
if {[catch {file attributes $dir -longname} ldir]} {
set ldir $dir
}
set lfile [file join $ldir [file tail $file]]
}
file nativename $lfile
}
proc regSetConfFile {file} {
global serverKey serverConfFile
regSetValue $serverKey $serverConfFile [file nativename $file]
}
proc regGetWhere {} {
global serverKey
regGetValue $serverKey Where 0
}
proc regSetWhere {where} {
global serverKey
regSetValue $serverKey Where $where dword
}
proc regGetValue {key name default} {
if {![isWindows]} {
puts "--regGetValue $key $name"
return $default
}
package require registry 1.0
if {[catch {registry get $key $name} value]} {
return $default
}
if {[string compare $value {}] == 0} {
return $default
}
return $value
}
proc regSetValue {key name value {type sz}} {
if {![isWindows]} {
puts "--regSetValue $key $name $value"
return 1
}
package require registry 1.0
if {[catch {registry set $key $name $value $type}]} {
return 2
}
return 0
}
########################################################################
#
# install / uninstall DLL s
#
proc fileInstall { prg } {
global env
global filesCpy11 filesCpy20
if {![isWindows]} {
return 1
}
switch -- [get_os_version] {
"Windows 95" -
"Windows 98" -
"Windows Me" {
set winDir $env(windir)
set sysDir $winDir/system
set filesCpy $filesCpy11
}
default {
set winDir $env(SystemRoot)
set sysDir $winDir/system32
set filesCpy $filesCpy20
}
}
set toDir [getDirName $prg ]
foreach n $filesCpy {
file copy -force $n $toDir
}
return 0
}
proc fileRemove { prg } {
global filesDel11 filesDel20
if {![isWindows]} {
return 1
}
switch -- [get_os_version] {
"Windows 95" {
set filesDel $filesDel11
}
"Windows 98" -
"Windows Me" {
set filesDel $filesDel20
}
default {
set filesDel $filesDel20
}
}
set fromDir [getDirName $prg ]
foreach n $filesDel {
file delete -force $fromDir/$n
}
return 0
}
########################################################################
#
# Wrap/Unwrap program
#
proc execWrap { pw lb dlg prg enc } {
set prgName [$prg get]
set encName [$enc get]
# Make sure the program name is not empty
if {[string compare $prgName {}] == 0} {
confErrorDialog $dlg "Program must be specified.\nClick \"Browse..\" button for browsing."
return
}
# It is dangerous to wrap programs in the system directory.
set prgdir [file nativename [getDirName $prgName]]
set sysdir [file nativename [getSystemDir]]
if {[string compare -nocase $prgdir $sysdir] == 0} {
tk_messageBox -icon error -type ok -title "Directory Error" \
-parent $dlg \
-message "Cannot wrap applications in the system directory.\nPlease copy the EXE file to elsewhere and wrap the copied one."
destroy $dlg
return 1
}
# Okay, copy the wrapper DLLs.
if { [fileInstall $prgName] } {
tk_messageBox -icon warning -type ok \
-title "Warning" \
-message "Cannot install DLLs" \
-parent $dlg
destroy $dlg
return 1
}
if { [regSetEncode $prgName $encName] } {
tk_messageBox -icon warning -type ok \
-title "Warning" \
-message "Cannot set encoding" \
-parent $dlg
fileRemove $prgName
destroy $dlg
return 2
}
# if local flag is on, create $prgName.local.
global local_dll
if {$local_dll} {
create_dot_local $prgName $dlg
} else {
remove_dot_local $prgName $dlg
}
if { [checkList $lb $prgName] == 0 } {
appendList $lb $prgName
}
saveList [getList $lb]
destroy $dlg
}
proc execUnwrap { pw lb dlg prg } {
set prgName [$prg get]
if {[support_dll_redirection] && [file exists $prgName.local]} {
set ans [tk_messageBox -icon question -type yesno \
-title "Confirmation" \
-message "Also remove $prgName.local file?" \
-parent $dlg]
if {[string compare $ans yes] == 0} {
remove_dot_local $prgName $dlg
}
}
if { [checkList $lb $prgName] == 1 } {
fileRemove $prgName
}
deleteList $lb $prgName
saveList [getList $lb]
destroy $dlg
}
proc create_dot_local {path {parent .}} {
set dotlocal $path.local
if {[file exists $dotlocal]} {
return 0
}
if {[catch {open $dotlocal w} fh]} {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "Cannot create $dotlocal" -parent $parent
return -1
}
close $fh
return 0
}
proc remove_dot_local {path {parent .}} {
set dotlocal $path.local
if {[file exists $dotlocal] && [catch {file delete $dotlocal}]} {
tk_messageBox -icon warning -type ok -title "Warning" \
-message "Cannot remove $dotlocal" -parent $parent
return -1
}
return 0
}
########################################################################
#
# dialog for Wrap / Unwrap
#
proc syncEncode { v i op } {
global prgName encName
set enc [regGetEncode $prgName]
if { [string compare $encName $enc] != 0 } {
set encName $enc
}
}
proc confBrowse { p ePrg eEnc } {
set types {
{ "Executable" .exe }
}
set file [tk_getOpenFile -filetypes $types -parent $p ]
if { [string compare $file ""] == 0 } {
return
}
set enc [regGetEncode $file]
$ePrg delete 0 end
$ePrg insert 0 $file
}
proc confWrap { pw lb } {
global prgName encName local_dll
set idx [$lb curselection]
if { [llength $idx] == 1 } {
set prg [$lb get $idx]
set local_dll [file exists $prg.local]
} else {
set prg ""
}
set top .wrap
toplevel $top
grab $top
wm title $top "idn wrapper - Wrap Executable"
frame $top.f1 -bd 1 -relief raised
frame $top.f2 -bd 1 -relief raised
pack $top.f1 -side top -fill x -expand on
pack $top.f2 -side top -fill x -expand on
frame $top.f1.f
pack $top.f1.f -fill both -expand on -padx 4 -pady 4
set w $top.f1.f
label $w.prgtitle -text "Program:"
label $w.enctitle -text "Encoding:"
entry $w.prgname -relief sunken -width 56 -textvariable prgName
entry $w.encname -relief sunken -width 8 -textvariable encName
set w_prgname $w.prgname
set w_encname $w.encname
button $w.browse -text "Browse.." \
-command [list confBrowse $w $w_prgname $w_encname]
frame $w.rbf
radiobutton $w.rbf.encdef -text "Default" -variable encName \
-value "Default"
radiobutton $w.rbf.encutf -text "UTF-8" -variable encName \
-value "UTF-8"
pack $w.rbf.encdef $w.rbf.encutf -side left -padx 4
grid $w.prgtitle -row 0 -column 0 -sticky e
grid $w.enctitle -row 1 -column 0 -sticky e
grid $w.prgname -row 0 -column 1 -sticky we -pady 4 -padx 2 -columnspan 2
grid $w.browse -row 0 -column 3 -sticky w -pady 4 -padx 4
grid $w.encname -row 1 -column 1 -sticky we -pady 4 -padx 2
grid $w.rbf -row 1 -column 2 -sticky w -padx 2
if {[support_dll_redirection]} {
checkbutton $w.local -text "Force local DLL reference" \
-variable local_dll
grid $w.local -row 2 -column 1 -sticky w -padx 4 -pady 4
}
grid columnconfig $w 1 -weight 1 -minsize 20
grid columnconfig $w 2 -weight 2 -minsize 20
trace variable prgName w syncEncode
$w.prgname delete 0 end
$w.prgname insert 0 $prg
focus $w.prgname
set w $top.f2
button $w.wrap -text "Wrap" \
-command [list execWrap $pw $lb $top $w_prgname $w_encname]
button $w.cancel -text "Cancel" \
-command [list destroy $top]
pack $w.cancel -side right -fill y -padx 12 -pady 4
pack $w.wrap -side right -fill y -padx 12 -pady 4
tkwait window $top
}
proc confUnwrap { pw lb } {
set idx [$lb curselection]
if { [llength $idx] != 1 } {
tk_messageBox -icon warning -type ok \
-title "Warning" \
-message "first, select unwrapping executable" \
-parent $pw
return 0
}
set prg [$lb get $idx]
if { [string length $prg] == 0 } {
tk_messageBox -icon warning -type ok \
-title "Warning" \
-message "first, select unwrapping executable" \
-parent $pw
return 0
}
set top .unwrap
toplevel $top
grab $top
wm title $top "idn wrapper - Unwrap Executable"
frame $top.f1 -bd 1 -relief raised
frame $top.f2 -bd 1 -relief raised
pack $top.f2 -side bottom -fill x
pack $top.f1 -side bottom -fill x -expand on
frame $top.f1.f
pack $top.f1.f -padx 4 -pady 4 -fill both -expand on
set w $top.f1.f
label $w.prgtitle -text "Program:"
entry $w.prgname -relief sunken -width 56 -textvariable prgName
$w.prgname delete 0 end
$w.prgname insert 0 $prg
set w_prgname $w.prgname
grid $w.prgtitle -row 0 -column 0 -sticky w
grid $w.prgname -row 0 -column 1 -sticky we -pady 4
grid columnconfig $w 1 -weight 1 -minsize 20
set w $top.f2
button $w.wrap -text "Unwrap" \
-command [list execUnwrap $pw $lb $top $w_prgname]
button $w.cancel -text "Cancel" \
-command [list destroy $top]
pack $w.cancel -side right -padx 12 -pady 6
pack $w.wrap -side right -padx 12 -pady 6
focus $w.wrap
tkwait window $top
}
proc unwrapAll {pw lb} {
set ans [tk_messageBox -type yesno -default no -icon question \
-parent $pw -title {idn wrapper Configuration} \
-message {Really unwrap all programs?}]
if {[string compare $ans yes] != 0} {
return
}
foreach prog [$lb get 0 end] {
fileRemove $prog
}
if {[support_dll_redirection]} {
set delete_type yes
foreach prog [$lb get 0 end] {
if {![file exists $prog.local]} continue
switch -- $delete_type {
yes -
no {
set delete_type [dotLocalDialog $prog $delete_type]
}
}
switch -- $delete_type {
yes -
yesall {
remove_dot_local $prog $pw
}
}
}
}
$lb delete 0 end
saveList {}
}
proc rewrapAll {pw lb} {
set ans [tk_messageBox -type yesno -default yes -icon question \
-parent $pw -title {idn wrapper Configuration} \
-message {Really rewrap all programs?}]
if {[string compare $ans yes] != 0} {
return
}
foreach prog [$lb get 0 end] {
fileInstall $prog
}
}
proc confLog {pw} {
global _logLevel _logFile
set top .log
catch {destroy $top}
toplevel $top
wm title $top "idn wrapper - Log Configuration"
# wm transient $top $pw
set _logLevel [regGetLogLevel]
set _logFile [regGetLogFile]
frame $top.f1 -bd 1 -relief raised
frame $top.f2 -bd 1 -relief raised
pack $top.f2 -side bottom -fill x
pack $top.f1 -side top -fill both -expand on
set w $top.f1
label $w.lv_l -text "Log Level:"
frame $w.lv_v
global serverLogLevelNone
set i 0
foreach {lvl text} [list $serverLogLevelNone None \
0 Fatal 1 Error 2 Warning 3 Info 4 Trace] {
radiobutton $w.lv_v.btn$i -text $text -value $lvl -variable _logLevel
pack $w.lv_v.btn$i -side left -padx 3
incr i
}
label $w.ld_l -text "Log File:"
frame $w.ld_v
entry $w.ld_v.e -width 40 -textvariable _logFile
focus $w.ld_v.e
button $w.ld_v.b -text "Browse.." -command [list selectLog $top $w.ld_v.e]
pack $w.ld_v.b -side right -fill y -padx 6
pack $w.ld_v.e -side left -fill both -expand yes
#label $w.lo_l -text "Log Operation:"
frame $w.lo_v
button $w.lo_v.show -text "View" -command [list showLog $top]
button $w.lo_v.delete -text "Delete" -command [list deleteLog $top]
pack $w.lo_v.show $w.lo_v.delete -side left -padx 4
grid $w.lv_l -row 0 -column 0 -sticky e -padx 4
grid $w.ld_l -row 1 -column 0 -sticky e -padx 4
#grid $w.lo_l -row 2 -column 0 -sticky e -padx 4
grid $w.lv_v -row 0 -column 1 -sticky w -padx 4 -pady 4
grid $w.ld_v -row 1 -column 1 -sticky we -padx 4 -pady 4
grid $w.lo_v -row 2 -column 1 -sticky w -padx 4 -pady 4
set w $top.f2
button $w.ok -text "OK" -command [list configureLog $top]
button $w.cancel -text "Cancel" -command [list destroy $top]
pack $w.cancel -side right -padx 12 -pady 6
pack $w.ok -side right -padx 12 -pady 6
}
proc configureLog {top} {
global _logLevel _logFile
if {$_logLevel != [regGetLogLevel] ||
[string compare $_logFile [regGetLogFile]] != 0} {
set dir [file dirname $_logFile]
if {[string compare $dir {}]} {
if {![file exists $dir]} {
confErrorDialog $top "Directory $dir doesn't exist"
return
} elseif {![file isdirectory $dir]} {
confErrorDialog $top "$dir is not a directory"
return
}
}
regSetLogLevel $_logLevel
regSetLogFile $_logFile
tk_messageBox -type ok -default ok -icon info -parent $top \
-title "idn wrapper Configuration" \
-message "Changing log level or file does not affect already running processes."
}
destroy $top
}
proc selectLog {top e} {
global logFileNameDef
set file [tk_getSaveFile -title {idn wrapper Logfile Selection} \
-defaultextension .log \
-filetypes {{{Log Files} .log} {{All Files} *}} \
-initialfile $logFileNameDef \
-parent $top]
if {[string compare $file {}]} {
$e delete 0 end
$e insert insert $file
}
}
proc showLog {top} {
global _logFile
if {[catch {exec notepad.exe $_logFile &} r]} {
confErrorDialog $top "Cannot execute notepad"
}
}
proc deleteLog {top} {
global _logFile
set ans [tk_messageBox -type yesno -default no -icon question \
-parent $top -title "idn wrapper Configuration" \
-message "Really delete $_logFile?"]
if {[string compare $ans yes] == 0} {
file delete $_logFile
}
}
########################################################################
#
# dialog for .local deletion
#
proc dotLocalDialog {path {default yes}} {
set parent .
set dlg .dotlocaldlg
catch {destroy $dlg}
toplevel $dlg
wm iconname $dlg Dialog
wm title $dlg Confirmation
wm transient $dlg $parent
wm protocol $dlg WM_DELETE_WINDOW {}
frame $dlg.f1 -bd 1 -relief raised
frame $dlg.f2 -bd 1 -relief raised
pack $dlg.f1 -side top -fill x -expand on -ipadx 2m -ipady 4m
pack $dlg.f2 -side top -fill x -ipadx 2m
label $dlg.f1.bm -bitmap question -bd 0
label $dlg.f1.msg -text "Remove $path.local?" -wraplength 10c
pack $dlg.f1.bm -side left -padx 3m -pady 2m
pack $dlg.f1.msg -side left -padx 2m -pady 2m
global dotlocal_selection
foreach {btn lbl} {yes Yes no No yesall {Yes to All} noall {No to All}} {
set bw $dlg.f2.btn$btn
button $bw -text $lbl -default normal \
-command [list set dotlocal_selection $btn]
if {[string compare $default $btn] == 0} {
$bw configure -default active
focus $bw
}
bind $bw <Return> {%W flash; %W invoke}
pack $bw -side left -padx 3m -pady 2m
}
grab $dlg
::tk::PlaceWindow $dlg widget $parent
vwait dotlocal_selection
destroy $dlg
return $dotlocal_selection
}
########################################################################
#
# dialog for advanced configuration
#
proc advancedConf {pw} {
set top .adv
catch {destroy $top}
toplevel $top
wm title $top "idn wrapper - Advanced Configuration"
global _mdnOperation _confFile
set _mdnOperation [regGetWhere]
set _confFile [regGetConfFile]
foreach f {f1 f2 f3} {
frame $top.$f -bd 1 -relief raised
pack $top.$f -side top -fill x
}
set f $top.f1
label $f.lbl -text {IDN Wrapping Mode}
set w $f.f
frame $w
foreach {rb val txt} [list \
rb1 0 {Wrap both WINSOCK 1.1 and WINSOCK 2.0} \
rb2 2 {Wrap only WINSOCK 1.1} \
rb3 3 {Wrap only WINSOCK 2.0} \
rb4 1 "Wrap only WINSOCK2.0 if it exists.\nOtherwise wrap only WINSOCK1.1"] {
radiobutton $w.$rb -text $txt -variable _mdnOperation -value $val \
-anchor w -justify left
pack $w.$rb -side top -fill x -pady 1
}
pack $f.lbl -side top -fill x -pady 4
pack $w -side top -fill both -padx 20 -pady 10
set f $top.f2
label $f.lbl -text {IDN Configuration}
pack $f.lbl -side top -fill x -pady 6
set w $f.f
frame $w
pack $w -side top -fill both -padx 10 -pady 6
label $w.l1 -text {Config File:}
#label $w.l2 -text {Config Operation:}
entry $w.e -width 40 -textvariable _confFile
focus $w.e
button $w.br -text "Browse.." -command [list selectConf $top $w.e]
button $w.b -text Edit -command [list editConf $top]
grid $w.l1 -row 0 -column 0 -sticky e -padx 4
#grid $w.l2 -row 1 -column 0 -sticky e -padx 4
grid $w.e -row 0 -column 1 -sticky we -padx 4 -pady 4
grid $w.b -row 1 -column 1 -sticky w -padx 4 -pady 4
grid $w.br -row 0 -column 2 -sticky w -padx 4 -pady 4
set w $top.f3
button $w.ok -text "OK" -command [list advConf $top]
button $w.cancel -text "Cancel" -command [list destroy $top]
pack $w.cancel -side right -padx 12 -pady 8
pack $w.ok -side right -padx 12 -pady 8
}
proc editConf {top} {
global _confFile
if {[catch {exec notepad.exe $_confFile &} r]} {
confErrorDialog $top "Cannot execute notepad"
}
}
proc selectConf {top e} {
global confFileNameDef
set file [tk_getOpenFile -title {idn wrapper Config File Selection} \
-defaultextension .conf \
-filetypes {{{Config Files} .conf} {{All Files} *}} \
-initialfile $confFileNameDef \
-parent $top]
if {[string compare $file {}]} {
$e delete 0 end
$e insert insert $file
}
}
proc advConf {top} {
global _mdnOperation _confFile
regSetWhere $_mdnOperation
regSetConfFile $_confFile
destroy $top
}
########################################################################
#
# utility
#
proc confErrorDialog {top message} {
tk_messageBox -default ok -icon error -parent $top -type ok \
-title {idn wrapper Configuration Error} -message $message
}
proc isWindows {} {
global tcl_platform
expr {[string compare $tcl_platform(platform) "windows"] == 0}
}
########################################################################
#
# config program start here
#
wm title . "idn wrapper - Configuration"
wm iconname . "idn wrapper - Configuration"
label .title -bd 1 -relief raised -pady 5 \
-text "idn wrapper Configuration Program version $version"
frame .left -bd 1 -relief raised
frame .right -bd 1 -relief raised
frame .lst
label .lst.title -text "Wrapped Programs" -pady 3
listbox .lst.list -width 64 -height 16 -setgrid 1 \
-xscrollcommand ".lst.xscroll set" \
-yscrollcommand ".lst.yscroll set"
scrollbar .lst.yscroll -orient vertical -command ".lst.list yview"
scrollbar .lst.xscroll -orient horizontal -command ".lst.list xview"
grid .lst.title -row 0 -column 0 -columnspan 2 -sticky news
grid .lst.list -row 1 -column 0 -sticky news
grid .lst.xscroll -row 2 -column 0 -sticky news
grid .lst.yscroll -row 1 -column 1 -sticky news
grid rowconfig .lst 1 -weight 1
grid columnconfig .lst 0 -weight 1
frame .btn
button .btn.wrap -text "Wrap.." -command [list confWrap . .lst.list]
button .btn.unwrap -text "Unwrap.." -command [list confUnwrap . .lst.list]
button .btn.unwrapall -text "Unwrap All" -command [list unwrapAll . .lst.list]
button .btn.rewrapall -text "Rewrap All" -command [list rewrapAll . .lst.list]
frame .btn.spacing1 -width 1 -height 12 -bd 0
button .btn.log -text "Log.." -command [list confLog .]
frame .btn.spacing2 -width 1 -height 12 -bd 0
button .btn.adv -text "Advanced.." -command [list advancedConf .]
button .btn.exit -text Exit -command exit
pack .btn.wrap -side top -fill x -pady 4
pack .btn.unwrap -side top -fill x -pady 4
pack .btn.unwrapall -side top -fill x -pady 4
pack .btn.rewrapall -side top -fill x -pady 4
pack .btn.spacing1 -side top
pack .btn.log -side top -fill x -pady 4
pack .btn.spacing2 -side top
pack .btn.adv -side top -fill x -pady 4
pack .btn.exit -side bottom -fill x -pady 4
pack .lst -in .left -padx 4 -pady 4 -fill both -expand on
pack .btn -in .right -padx 6 -pady 4 -fill both -expand on
pack .title -side top -fill x
pack .right -side right -fill y
pack .left -side left -fill y -expand on
#
# then set current list into listbox
#
set theList [loadList]
#saveList $theList
putList .lst.list $theList
#
########################################################################