[Emc-commit] emc2/tcl/bin setupconfig.tcl,1.8,1.9

[John K. <jmk...@us...>]

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 ----