From: John K. <jmk...@us...> - 2005-12-23 04:48:14
|
Update of /cvsroot/emc/emc2/tcl/bin In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17781/tcl/bin Modified Files: setupconfig.tcl Log Message: more work on the config picker, and also on the run script - the run script now calls the picker to validate an ini passed on the command line, or to get an ini from the user if none was specified Index: setupconfig.tcl =================================================================== RCS file: /cvsroot/emc/emc2/tcl/bin/setupconfig.tcl,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** setupconfig.tcl 21 Dec 2005 05:05:51 -0000 1.8 --- setupconfig.tcl 23 Dec 2005 04:48:02 -0000 1.9 *************** *** 67,70 **** --- 67,103 ---- ################### PROCEDURE DEFINITIONS ##################### + # a kluge for older systems that don't have 'file normalize' + # (which was introduced with tcl 8.4) + # this version converts to an absolute path and eliminates + # any references to ./ and ../, but it doesn't do all the + # other things that normalize can do, such as resolve symlinks. + # it seems good enough for what this program needs to do + + proc file_normalize { input } { + # make path absolute + if { [ file pathtype $input ] != "absolute" } { + set input [ file join [ pwd ] $input ] + } + # split into component parts + set path_list [ file split $input ] + # remove any instances of ./ + set idx [ lsearch $path_list "." ] + while { $idx > 0 } { + set path_list [ lreplace $path_list $idx $idx ] + set idx [ lsearch $path_list "." ] + } + # remove any instances of ../ (and the preceding directory name) + set idx [ lsearch $path_list ".." ] + while { $idx > 0 } { + set path_list [ lreplace $path_list [ expr $idx -1 ] $idx ] + set idx [ lsearch $path_list ".." ] + } + set output "" + foreach name $path_list { + set output [ file join $output $name ] + } + return $output + } + # reads the directory, and fills in "config_list" and "details_list" *************** *** 146,150 **** } - # detail picker - lets you select from a list, displays details # of the selected item --- 179,182 ---- *************** *** 247,254 **** } ################### MENU PROCEDURE DEFINITIONS ##################### proc main_page {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state --- 279,303 ---- } + # proc to select an item (used to set initial selection) + proc detail_picker_select { item } { + # need globals to talk to the list and widget + global d_p_item_list d_p_item_widget + + set pick [ lsearch $d_p_item_list $item ] + # if 'item' isn't in the list, do nothing + if { $pick != -1 } { + # clear any existing selection + $d_p_item_widget selection clear 0 end + # mark the new selected item + $d_p_item_widget selection set $pick $pick + # invoke the callback to refresh + detail_picker_refresh + } + } + ################### MENU PROCEDURE DEFINITIONS ##################### proc main_page {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state *************** *** 286,291 **** } ! proc choose_run_config {} { ! # need globals to comminicate with wizard page buttons, # and for the configuration lists global choice top wizard_state --- 335,340 ---- } ! proc check_run_config {} { ! # need globals to communicate with wizard page buttons, # and for the configuration lists global choice top wizard_state *************** *** 295,305 **** global run_config_name run_ini_name - puts "run config name is $run_config_name" # if a config directory is already known, skip this stage if { $run_config_name != "" } { ! set wizard_state "choose_run_ini" return } # read the directory and set up list of configs get_config_list --- 344,366 ---- global run_config_name run_ini_name # if a config directory is already known, skip this stage if { $run_config_name != "" } { ! set wizard_state "check_run_ini" return } + # otherwise, need to pick a config + set wizard_state "choose_run_config" + return + } + proc choose_run_config {} { + # need globals to communicate with wizard page buttons, + # and for the configuration lists + global choice top wizard_state + global config_list details_list detail_picker_selection + # more globals for new and run config info + global new_config_name new_config_template new_config_readme + global run_config_name run_ini_name + # read the directory and set up list of configs get_config_list *************** *** 316,319 **** --- 377,385 ---- pack $f1 + # pre-select the current run config, if any + if { $run_config_name != "" } { + detail_picker_select [ file tail $run_config_name ] + } + # prep for the event loop set choice "none" *************** *** 336,341 **** return } ! set run_config_name $value ! set wizard_state "choose_run_ini" return } --- 402,407 ---- return } ! set run_config_name [ file_normalize $value ] ! set wizard_state "check_run_ini" return } *************** *** 343,348 **** } ! proc choose_run_ini {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state global run_config_name --- 409,414 ---- } ! proc check_run_ini {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state global run_config_name *************** *** 353,368 **** return } ! # not done yet ! popup "The next step is to see if there is more than one .ini fil in\n'$run_config_name'\nand if so, to pick one.\n\nBut thats not coded yet, so just click OK to continue" ! set run_config_name $run_config_name/foobar.ini ! set wizard_state "execute_run" return } ! proc execute_run {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state global run_config_name # not done yet popup "The next step is to invoke the run script to run\n'$run_config_name'\n\nBut thats not coded yet, so just click OK to quit." --- 419,517 ---- return } ! # get the names of all ini files in the selected directory ! set temp [ glob -directory $run_config_name *.ini ] ! set inis [ list ] ! foreach ini $temp { ! lappend inis [ file tail $ini ] ! } ! if { [ llength $inis ] == 0 } { ! popup "ERROR: no ini file(s) found in config directory\n\n'$run_config_name'\n\nClick OK to continue." ! set wizard_state "main_page" ! return ! } ! if { [ llength $inis ] == 1 } { ! # only one ini file, use it ! set run_config_name [ file join $run_config_name [ lindex $inis 0 ] ] ! set wizard_state "execute_run" ! return ! } ! # more than one, must choose ! set wizard_state "choose_run_ini" return } ! proc choose_run_ini {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state global run_config_name + # get the names of all ini files in the selected directory + set temp [ glob -directory $run_config_name *.ini ] + set inis [ list ] + foreach ini $temp { + lappend inis [ file tail $ini ] + } + # set up a list box so the user can pick one + set f1 [ wizard_page { "<--BACK" "CANCEL" "NEXT-->" } ] + set l1 [ label $f1.l1 -text "The config contains multiple ini files.\nPick one from the list below and click NEXT." ] + pack $l1 -padx 10 -pady 10 + # listbox for the ini files + set lb [ listbox $f1.lb ] + # pack the listbox into the wizard page + pack $lb + # load the list with names + foreach ini $inis { + $lb insert end [ file rootname $ini ] + } + # set the size of the list box + $lb configure -height 8 + # pack the page + pack $f1 + + # prep for the event loop + set choice "none" + # enter event loop + vwait choice + # a button was pushed, save selection + + set pick [ $lb curselection ] + # clear the window + pack forget $f1 + destroy $f1 + + switch $choice { + "CANCEL" { + set wizard_state "main_page" + return + } + "<--BACK" { + set wizard_state "choose_run_config" + return + } + "NEXT-->" { + if { $pick == "" } { + popup "You must select one ini file!" + return + } + # add name of selected ini file to directory name + set run_config_name [ file join $run_config_name [ lindex $inis $pick ] ] + # done + set wizard_state "execute_run" + return + } + } + } + + proc execute_run {} { + # need globals to communicate with wizard page buttons + global choice top wizard_state + global run_config_name run_mode + + if { $run_mode == "print" } { + # all we need to do is print the desired config name and exit + puts $run_config_name + exit 0 + } + # not done yet popup "The next step is to invoke the run script to run\n'$run_config_name'\n\nBut thats not coded yet, so just click OK to quit." *************** *** 372,376 **** proc config_manager {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state global config_list details_list detail_picker_selection --- 521,525 ---- proc config_manager {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state global config_list details_list detail_picker_selection *************** *** 453,457 **** proc not_implemented {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state --- 602,606 ---- proc not_implemented {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state *************** *** 463,467 **** proc new_intro {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state global new_config_name new_config_template new_config_readme --- 612,616 ---- proc new_intro {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state global new_config_name new_config_template new_config_readme *************** *** 499,503 **** proc new_get_name {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state new_config_name --- 648,652 ---- proc new_get_name {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state new_config_name *************** *** 548,552 **** proc new_get_template {} { ! # need globals to comminicate with wizard page buttons, # and for the configuration lists global choice top wizard_state --- 697,701 ---- proc new_get_template {} { ! # need globals to communicate with wizard page buttons, # and for the configuration lists global choice top wizard_state *************** *** 618,622 **** proc new_get_description {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state global new_config_name new_config_template new_config_readme --- 767,771 ---- proc new_get_description {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state global new_config_name new_config_template new_config_readme *************** *** 679,683 **** proc new_verify {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state global new_config_name new_config_template new_config_readme --- 828,832 ---- proc new_verify {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state global new_config_name new_config_template new_config_readme *************** *** 956,964 **** proc new_config_done {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state ! global new_config_name popup "Your new configuration '$new_config_name' has been created.\nClick OK to return to the main menu." set wizard_state "config_manager" return --- 1105,1115 ---- proc new_config_done {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state ! global new_config_name run_config_name popup "Your new configuration '$new_config_name' has been created.\nClick OK to return to the main menu." + # set default run config to the newly created one + set run_config_name $new_config_name set wizard_state "config_manager" return *************** *** 966,970 **** proc new_config_error {} { ! # need globals to comminicate with wizard page buttons global choice top wizard_state --- 1117,1121 ---- proc new_config_error {} { ! # need globals to communicate with wizard page buttons global choice top wizard_state *************** *** 998,1002 **** } # make into an absolute path ! set abs_input [ file normalize $input ] # is it a directory? if { [ file isdirectory $abs_input ] == 1 } { --- 1149,1153 ---- } # make into an absolute path ! set abs_input [ file_normalize $input ] # is it a directory? if { [ file isdirectory $abs_input ] == 1 } { *************** *** 1084,1088 **** } # make into absolute path to directory ! set configs_dir [ file normalize $configs_dir ] # remove option and its argument from argv set argv [ lreplace $argv $configs_index [expr $configs_index + 1]] --- 1235,1239 ---- } # make into absolute path to directory ! set configs_dir [ file_normalize $configs_dir ] # remove option and its argument from argv set argv [ lreplace $argv $configs_index [expr $configs_index + 1]] *************** *** 1095,1102 **** if { $configs_dir == "" } { # try env variable ! if { [ info exists env(EMC2_ORIG_CONFIG_DIR) ] } { ! set configs_dir [ file normalize $env(EMC2_ORIG_CONFIG_DIR) ] if { [ file isdirectory $configs_dir ] != 1 } { ! popup "ERROR: environment variable EMC2_ORIG_CONFIG_DIR is\n\n'$env(EMC2_ORIG_CONFIG_DIR)'\n\nwhich is not a directory.\n\nClick OK to exit." exit -1 } --- 1246,1253 ---- if { $configs_dir == "" } { # try env variable ! if { [ info exists env(EMC2_CONFIG_DIR) ] } { ! set configs_dir [ file_normalize $env(EMC2_CONFIG_DIR) ] if { [ file isdirectory $configs_dir ] != 1 } { ! popup "ERROR: environment variable EMC2_CONFIG_DIR is\n\n'$env(EMC2_CONFIG_DIR)'\n\nwhich is not a directory.\n\nClick OK to exit." exit -1 } *************** *** 1106,1110 **** # maybe we're running in the top level EMC2 dir if { [ file isdirectory "configs" ] } { ! set configs_dir [ file normalize "configs" ] } } --- 1257,1261 ---- # maybe we're running in the top level EMC2 dir if { [ file isdirectory "configs" ] } { ! set configs_dir [ file_normalize "configs" ] } } *************** *** 1112,1116 **** # maybe we're running in the configs dir or another at that level if { [ file isdirectory "../configs" ] } { ! set configs_dir [ file normalize "../configs" ] } } --- 1263,1267 ---- # maybe we're running in the configs dir or another at that level if { [ file isdirectory "../configs" ] } { ! set configs_dir [ file_normalize "../configs" ] } } *************** *** 1118,1122 **** # maybe we're running in an inidividual config dir if { [ file isdirectory "../../configs" ] } { ! set configs_dir [ file normalize "../../configs" ] } } --- 1269,1273 ---- # maybe we're running in an inidividual config dir if { [ file isdirectory "../../configs" ] } { ! set configs_dir [ file_normalize "../../configs" ] } } *************** *** 1155,1160 **** set run_config_name [ resolve_config $run_config_name ] # set mode and initial state - set wizard_state "choose_run_config" set run_mode "run" } "--get-config" { --- 1306,1311 ---- set run_config_name [ resolve_config $run_config_name ] # set mode and initial state set run_mode "run" + set wizard_state "check_run_config" } "--get-config" { *************** *** 1166,1179 **** set run_config_name [ resolve_config $run_config_name ] # set mode and initial state - set wizard_state "choose_run_config" set run_mode "print" } "--new" { # delete option from argv set argv [ lreplace $argv $option_index $option_index ] ! # set initial state set wizard_state "new_intro" } "" { set wizard_state "main_page" } --- 1317,1335 ---- set run_config_name [ resolve_config $run_config_name ] # set mode and initial state set run_mode "print" + set wizard_state "check_run_config" } "--new" { # delete option from argv set argv [ lreplace $argv $option_index $option_index ] ! # set mode and initial state ! set run_config_name "" ! set run_mode "run" set wizard_state "new_intro" } "" { + # set mode and initial state + set run_config_name "" + set run_mode "run" set wizard_state "main_page" } *************** *** 1191,1198 **** proc state_machine {} { ! global choice wizard_state while { $wizard_state != "quit" } { - puts "state is $wizard_state" # execute the code associated with the current state $wizard_state --- 1347,1353 ---- proc state_machine {} { ! global choice wizard_state run_config_name while { $wizard_state != "quit" } { # execute the code associated with the current state $wizard_state *************** *** 1201,1205 **** state_machine - puts Quitting! cd $old_dir --- 1356,1359 ---- |