idnconf.tcl

package of develop dns

    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

#
########################################################################