#!/usr/bin/env tclsh package require Tk package require json package require json::write package require inifile # overall vars set appdir [ file dirname [ file normalize [ info script ] ] ] # check if we're running from a starpack if [string match *app-conf $appdir] { set appdir [ file normalize [ file join $appdir ".." ".." ".." ] ] } puts "Working directory: $appdir" set conffile [ file join $appdir "config.json" ] set labelfile [ file join $appdir "labels.ini" ] # main configuration read/write procedures proc readrawjson {fname} { # read the JSON contents set fp [open $fname r] set rawdata [read $fp] close $fp # parse the JSON contents set confdict [::json::json2dict $rawdata] return $confdict } proc readjson {fname} { set confdict [readrawjson $fname] # update the controls according to the configuration dict for {vname vval} $confdict { global conf_$vname set conf_$vname $vval } return $confdict } proc dict2json {dictToEncode} { ::json::write object {*}[dict map {k v} $dictToEncode { if [string is boolean -strict $v] { set v $v } elseif [string is integer -strict $v] { set v $v } else { set v [::json::write string $v] } }] } proc writejson {fname} { set confdict [readrawjson $fname] dict for {vname vval} $confdict { global conf_$vname dict set confdict $vname [set conf_$vname] } set fdata [dict2json $confdict] set fp [open $fname w] puts $fp $fdata close $fp } # dialog button helpers proc rereadconfig {fname msg} { set answer [tk_messageBox -message $msg -icon question -type yesno] switch -- $answer { yes {readjson $fname} no {} } } proc saveconfig {fname msg} { set answer [tk_messageBox -message $msg -icon question -type yesno] switch -- $answer { yes {writejson $fname} no {} } } proc exitapp {fname msg} { saveconfig $fname $msg exit } # read GUI labels ini file set lbls [::ini::open $labelfile r] set backends [::ini::value $lbls general backends] # overall provider tab layout ttk::notebook .prov foreach back $backends { set framename .prov.$back set tabname [::ini::value $lbls config.gui.$back tabtitle] ttk::frame $framename .prov add $framename -text $tabname } # General controls (need to be hardcoded) set dbglbl [::ini::value $lbls config.gui.general debug] set iplbl [::ini::value $lbls config.gui.general server_listen_ip] set portlbl [::ini::value $lbls config.gui.general server_port] set ualbl [::ini::value $lbls config.gui.general useragent] ttk::checkbutton .prov.general.debugchk -text $dbglbl -variable conf_debug -onvalue true -offvalue false ttk::label .prov.general.serviplbl -text $iplbl ttk::entry .prov.general.serviptxt -textvariable conf_server_listen_ip -width 16 ttk::label .prov.general.servportlbl -text $portlbl ttk::entry .prov.general.servporttxt -textvariable conf_server_port -width 5 ttk::label .prov.general.ualbl -text $ualbl ttk::entry .prov.general.uatxt -textvariable conf_useragent -width 60 grid .prov.general.debugchk -column 0 -row 0 -sticky ne -ipadx 5 -ipady 5 grid .prov.general.serviplbl -column 1 -row 0 -sticky ne -ipadx 5 -ipady 5 grid .prov.general.serviptxt -column 2 -row 0 -sticky ew -padx 5 -pady 5 grid .prov.general.servportlbl -column 3 -row 0 -sticky ne -ipadx 5 -ipady 5 grid .prov.general.servporttxt -column 4 -row 0 -sticky ew -padx 5 -pady 5 grid .prov.general.ualbl -column 0 -row 2 -sticky ne -ipadx 5 -ipady 5 grid .prov.general.uatxt -column 1 -row 2 -sticky ew -columnspan 4 -padx 5 -pady 5 # backend config controls foreach back $backends { if {$back ne "general"} { set section config.gui.$back set params [::ini::keys $lbls $section] set rowidx 1 foreach key $params { if {$key ne "tabtitle"} { set lbltext [::ini::value $lbls $section $key] set cvarname [string cat conf_ $key] set guiname .prov.$back.$key if {$key eq [string cat $back _backend_enabled]} { set chkname [string cat $guiname chk] ttk::checkbutton $chkname -text $lbltext \ -variable $cvarname -onvalue true -offvalue false grid $chkname -column 0 -row 0 -sticky ne -ipadx 5 -ipady 5 } else { set ewidth 40 set lblname [string cat $guiname lbl] set txtname [string cat $guiname txt] ttk::label $lblname -text $lbltext ttk::entry $txtname -textvariable $cvarname -width $ewidth grid $lblname -column 0 -row $rowidx -sticky ne -ipadx 5 -ipady 5 grid $txtname -column 1 -row $rowidx -sticky ew -padx 5 -pady 5 } incr rowidx } } } } # lower button row foreach lname {reset exit save credits savemodal resetmodal} { set vname [string cat $lname lbl] set $vname [::ini::value $lbls config.gui.general $lname] } ttk::frame .btns -padding 4 ttk::button .btns.reset -text $resetlbl -command {rereadconfig $conffile $resetmodallbl} ttk::button .btns.exit -text $exitlbl -command {exitapp $conffile $savemodallbl} ttk::button .btns.save -text $savelbl -command {saveconfig $conffile $savemodallbl} ttk::label .btns.lbl -text $creditslbl pack .btns.save -side right -padx 3 -pady 3 pack .btns.exit -side right -padx 3 -pady 3 pack .btns.reset -side right -padx 3 -pady 3 pack .btns.lbl -side left -padx 3 -pady 3 # place the tabs and buttons grid .prov -column 0 -row 0 -sticky nsew grid .btns -column 0 -row 1 -sticky sew # root grid geometry: don't resize the button row grid columnconfigure . 0 -weight 1 grid rowconfigure . 0 -weight 1 grid rowconfigure . 1 -weight 0 # iterate over available platform-dependent themes, apply "clam" if none found ttk::style theme use clam catch {ttk::style theme use gtkTtk} catch {ttk::style theme use aqua} catch {ttk::style theme use winnative} catch {ttk::style theme use vista} wm title . "StreamGoose config" catch {wm title . [::ini::value $lbls config.gui.general windowtitle]} # stop working with the labels file ::ini::close $lbls # read the initial config readjson $conffile