[Nsclspectcl-cvscommits] SpecTcl/Scripts fileall.tcl,4.2,4.2.2.1

[Ron F. <ro...@us...>]

Update of /cvsroot/nsclspectcl/SpecTcl/Scripts
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv26380

Modified Files:
      Tag: SpecTcl-2-1-fixes
	fileall.tcl 
Log Message:
Defect 145 repair:  Spectrum, gates, parameters with funny names can cause
saveall and loadall to produce garbage


Index: fileall.tcl
===================================================================
RCS file: /cvsroot/nsclspectcl/SpecTcl/Scripts/fileall.tcl,v
retrieving revision 4.2
retrieving revision 4.2.2.1
diff -C2 -d -r4.2 -r4.2.2.1
*** fileall.tcl	19 Jun 2003 18:57:29 -0000	4.2
--- fileall.tcl	22 Oct 2004 19:23:36 -0000	4.2.2.1
***************
*** 293,296 ****
--- 293,307 ----
  #   Change log:
  #    $Log$
+ #    Revision 4.2.2.1  2004/10/22 19:23:36  ron-fox
+ #    Defect 145 repair:  Spectrum, gates, parameters with funny names can cause
+ #    saveall and loadall to produce garbage
+ #
+ #    Revision 4.2.4.3  2004/10/22 18:22:10  ron-fox
+ #    Get quoting right in clean proc.
+ #
+ #    Revision 4.2.4.2  2004/10/22 18:09:36  ron-fox
+ #    Ensure that parameters, spectra and gates get written to file correctly,
+ #    and read back, even with all kinds of weird characters in names.
+ #
  #    Revision 4.2  2003/06/19 18:57:29  ron-fox
  #    Make properly work with scaled parameters, real parameters and axis scales.
***************
*** 302,305 ****
--- 313,328 ----
  global SpecTclHome
  
+ 
+ # Utility proc:  wraps a SpecTcl name (parameter, spectrum gate}
+ #   in a way that all sorts of special characters are allowed.
+ #   The ', ", { } \ $ characters are prepended with \.
+ #   The entire string is wrapped with a {} pair.
+ #
+ proc Wrap {input} {
+     regsub -all {[\"" "'{}\\\[\]$]} $input {\\&} output
+ 
+     return "{$output}"
+ }
+ 
  #   utility proc: returns input or "{}" if input is empty string:
  
***************
*** 327,330 ****
--- 350,376 ----
  }
  
+ # utility proc:  Return the number of parameters in a gate.
+ #     This can be: 
+ #        0  - If the gate does not depend directly on parameters.
+ #        1  - If the gate is a slice.
+ #        2  - If the gate is an ordinary 2-d gate.
+ #
+ # Parameters:
+ #    type   - The actual type of the gate.
+ # Returns:
+ #     0,1,2 as described above.
+ #
+ proc GateParameterCount {type} {
+     set GeneralType [GeneralGateType $type]
+ 
+     if {$GeneralType == "slice"} {
+ 	return 1
+     } elseif {$GeneralType == "twod"} {
+ 	return 2
+     } else {
+ 	return 0
+     }
+ }
+ 
  #
  #  write parameter definitions out  to file
***************
*** 341,344 ****
--- 387,391 ----
      foreach def $parms {
  	if {$def != "" } {
+ 
  	    set name     [lindex $def 0]
  	    set index    [lindex $def 1]
***************
*** 348,363 ****
  	    set high     [lindex $RangeAndUnits 1]
  	    set units    [lindex $RangeAndUnits 2]
! #	    
! 	    set command "handle \"parameter $name $index "
! 	    append command [listify $bits]
! #
! 	    # The axis definitions are inside of {}s and individual
! 	    # missing items are replaced by {}'s.
! #
! 	    append command " \{"
! 	    append command " " [listify $low]
! 	    append command " " [listify $high]
! 	    append command " " [listify $units]
! 	    append command "\}"
  	    append command "\""
  	    puts $destination $command
--- 395,432 ----
  	    set high     [lindex $RangeAndUnits 1]
  	    set units    [lindex $RangeAndUnits 2]
! 	    set command "handle \"parameter [Wrap $name] $index "
! 
! 	    # That's all we are gaurenteed, the name and index.
! 	    # If the bits are {} then that's all we got.
! 
! 
! 	    if {$bits == ""} {
! 
! 		#  This is a real parameter, but may have units:
! 		
! 		if {$units != ""} {
! 		    append command " " [Wrap $units]
! 		}
! 
! 	    } else {
! 
! 		#  This is an integer def:
! 
! 		append command " " $bits;# Here's the resolution in bits.
! 
! 		#  Only put in scale factors etc. if there's low/hi:
! 
! 		if {($low != "") && ($high != "")} {
! 		    append command " \{"
! 		    append command " " [listify $low]
! 		    append command " " [listify $high]
! 		    append command " " [Wrap $units]
! 		    append command "\}"
! 		}
! 	    }
! 
! 	     # Finish off the command and write it.
! 
! 
  	    append command "\""
  	    puts $destination $command
***************
*** 382,388 ****
  proc WriteSpectrum {name type params axes datatype dest} {
      set    command "handle \"spectrum "
!     append command "$name $type \{"
      foreach param   $params {
! 	append command "$param "
      }
      append command "\} \{"
--- 451,457 ----
  proc WriteSpectrum {name type params axes datatype dest} {
      set    command "handle \"spectrum "
!     append command "[Wrap $name] $type \{"
      foreach param   $params {
! 	append command "[Wrap $param] "
      }
      append command "\} \{"
***************
*** 454,461 ****
  #   determine which binding can be written out.
  #
- 
  #
! # Set the status of a gate.
! 
  proc SetStatus {name status} {
      global Gates
--- 523,536 ----
  #   determine which binding can be written out.
  #
  #
! #
! #  Set the status of a gate.
! # Parameters:
! #    name   [in]      - The name of the gate to ste thestatus of.
! #    status [in]      - The new status value.  
! # Returns:
! #    2 element list containing status and gate description.
! # Notes:
! #   Any status type is acceptable at this stage.
  proc SetStatus {name status} {
      global Gates
***************
*** 463,466 ****
--- 538,542 ----
      set desc [lindex $element 1]
      set Gates($name) [list $status $desc]
+     return $Gates($name);
  }
  
***************
*** 477,488 ****
  proc dependsOnDeleted {name} {
      global Gates
!     set   gate [lindex $Gates($name) 1]
      set   typedependent [lindex $gate 2]
  
!     if {[string first "-Deleted Parameter-" $typedependent] != -1} {
! 	return 1
!     } else {
! 	return 0
      }
     
  }
--- 553,572 ----
  proc dependsOnDeleted {name} {
      global Gates
!     set   gate          [lindex $Gates($name) 1]
!     set   type          [lindex $gate 1]
      set   typedependent [lindex $gate 2]
  
!     set paramcount [GateParameterCount $type]
! 
!     #  We rely on the fact that parameters are the first
!     #  items in the typedependent list:
! 
!     for {set i 0} {$i < $paramcount} {incr i} {
! 	if {[lindex $typedependent $i] == "-Deleted Parameter-"} {
! 	    return 1
! 	}
      }
+     return 0
+ 
     
  }
***************
*** 527,544 ****
  #
  proc GeneralGateType {type} {
!     switch --  $type {
! 	+ - \* - "-"  - T - F - c2band {
  	    return "compound"
  	}
! 	c - b {
  	    return "twod"
  	}
! 	gb - gc {
  	    return "gamma2"
  	}
! 	gs {
  	    return "gamma1"
  	}
! 	s {
  	    return "slice"
  	}
--- 611,629 ----
  #
  proc GeneralGateType {type} {
!     switch -regexp --  $type {
! 	^c2band$ -
! 	^[\*\+TF-]$ {
  	    return "compound"
  	}
! 	^[cb]$ {
  	    return "twod"
  	}
! 	^gb$|^gc$ {
  	    return "gamma2"
  	}
! 	^gs$ {
  	    return "gamma1"
  	}
! 	^s$ {
  	    return "slice"
  	}
***************
*** 546,561 ****
  }
  #
! #  Formats a gate to file... at this point, the gate is assumed to
  #  have had all of its dependencies written..to do that WriteGate was
! #  used in theory.
  #
! proc FormatGateToFile {name {dest stdout}} {
      global Gates
      set description [lindex $Gates($name) 1]
      set type        [lindex $description 1]
      
      # Everything but the gate dependent desription is format dependent:
  
!     append command handle  " "  \"gate " " [lindex $description 0]  " " \
                                   $type  " "
  
--- 631,654 ----
  }
  #
! #  Formats a gate for output to a file.... at this point, the gate is assumed to
  #  have had all of its dependencies written..to do that WriteGate was
! #  used in theory.  This is broken out into a separate function for  testability.
  #
! # Parameters:
! #     name   [in]    - The name of the gate to format.
! # Returns:
! #     A string that can be written to the output file, that will restore the
! #     gate definition when processed by e.g. loadall.
! #
! 
! proc FormatGate {name} {
      global Gates
      set description [lindex $Gates($name) 1]
      set type        [lindex $description 1]
+     set gatename    [lindex $description 0]
      
      # Everything but the gate dependent desription is format dependent:
  
!     append command handle  " "  \"gate " " [Wrap $gatename]  " " \
                                   $type  " "
  
***************
*** 572,576 ****
  	    append command "\{"
  	    foreach gate $parameters {
! 		append command $gate " "
  	    }
  	    append command "\}"
--- 665,669 ----
  	    append command "\{"
  	    foreach gate $parameters {
! 		append command [Wrap $gate] " "
  	    }
  	    append command "\}"
***************
*** 578,584 ****
  	twod {
  	    append command "\{"
! 	    set params [lindex $parameters 0]
  	    set points  [lrange $parameters 1 end]
! 	    append command [lindex $params 0] " " [lindex $params 1] " \{"
  	    foreach point $points {
  		append command \{ $point \} " "
--- 671,677 ----
  	twod {
  	    append command "\{"
! 	    set params  [lindex $parameters 0]
  	    set points  [lrange $parameters 1 end]
! 	    append command [Wrap [lindex $params 0]] " " [Wrap [lindex $params 1]] " \{"
  	    foreach point $points {
  		append command \{ $point \} " "
***************
*** 596,600 ****
  	    }
  	    append command "\} "
! 	    append command $spectrum
  	    append command "\}"
  	}
--- 689,693 ----
  	    }
  	    append command "\} "
! 	    append command [Wrap $spectrum]
  	    append command "\}"
  	}
***************
*** 604,608 ****
  	    set spectrum [lindex $parameters 1]
  	    append command "\{ " $point "\} "
! 	    append command $spectrum
  	    append command "\}"
  
--- 697,701 ----
  	    set spectrum [lindex $parameters 1]
  	    append command "\{ " $point "\} "
! 	    append command [Wrap $spectrum]
  	    append command "\}"
  
***************
*** 612,616 ****
  	    set param [lindex $parameters 0]
  	    set point [lindex $parameters 1]
! 	    append command $param " \{" $point "\}"
  	    append command "\}"
  	}
--- 705,709 ----
  	    set param [lindex $parameters 0]
  	    set point [lindex $parameters 1]
! 	    append command [Wrap $param] " \{" $point "\}"
  	    append command "\}"
  	}
***************
*** 618,622 ****
  
      append command \"
!     puts $dest $command
  }
  
--- 711,727 ----
  
      append command \"
! 
!     return $command
! }
! #
! #    Format a gate for output and write it to a file.
! # parameters:
! #    name  [in]  - Name of the gate.
! #    dest  [in]  - File descriptor open on the file (defaults to stdout if not
! #                  supplied.  Otherwise this is the return value of an [open].
! #
! #
! proc FormatGateToFile {name {dest stdout}} {
!     puts $dest [FormatGate $name]
  }
  
***************
*** 727,731 ****
  		if {$state != "unwritable"} {
  		    set command "handle \""
! 		    append command "apply $gatename $spectrum\""
  		    puts $dest $command
  		}
--- 832,836 ----
  		if {$state != "unwritable"} {
  		    set command "handle \""
! 		    append command "apply [Wrap $gatename]  [Wrap $spectrum]\""
  		    puts $dest $command
  		}
***************
*** 768,784 ****
      set parlist [parameter -list]
      foreach line $parlist {
! 	if [catch "parameter -delete [lindex $line 0]" res2] {
! 	    puts stderr "Error deleting SpecTcl parameters: \n $res2"
  	}
      }
      set speclist [spectrum -list]
      foreach line $speclist {
! 	if [catch "spectrum -delete [lindex $line 1]" res2] {
! 	    puts stderr "Error deleting SpecTcl spectrum: \n $res2"
  	}
      }
      set gatelist [gate -list]
      foreach line $gatelist {
! 	if [catch "gate -delete [lindex $line 0]" res2] {
  	    puts stderr "Error deleting SpecTcl gate: \n $res2"
  	}
--- 873,892 ----
      set parlist [parameter -list]
      foreach line $parlist {
! 	set paramName [lindex $line 0]
! 	if [catch [list parameter -delete $paramName] res2] {
! 	    puts stderr "Error deleting SpecTcl parameter: $paramName \n $res2"
  	}
      }
      set speclist [spectrum -list]
      foreach line $speclist {
! 	set specName [lindex $line 1]
! 	if [catch [list spectrum -delete  $specName] res2] {
! 	    puts stderr "Error deleting SpecTcl spectrum  $specName: \n $res2"
  	}
      }
      set gatelist [gate -list]
      foreach line $gatelist {
! 	set gateName [lindex $line 0]
! 	if [catch [list gate -delete  $gateName] res2] {
  	    puts stderr "Error deleting SpecTcl gate: \n $res2"
  	}