
# Parameter functions

## Load parameters from a file.  If clear_old is 1 then the old values will be
## deleted first

proc ic_param_load {file {clear_old 1}} {
    famboco_edit_load_param_values $file $clear_old
}

## Save parameters to a file.  If pats is given it's a list of glob
## patterns that specifies what nodes to save.

proc ic_param_save {file {pats ""}} {
    famboco_edit_save_param_values $file $pats
}

## Are there params available?

proc ic_param_is_loaded {} {
    global param_values
    return [array size param_values]
}
set dont_record_command(ic_param_is_loaded) 1

## Are the params modified?

proc ic_param_is_modified {} {
    global param_values param_values_modified
    
    return [info exists param_values_modified]
}
set dont_record_command(ic_param_is_modified) 1

## Set the parameters modified flag.

proc ic_param_set_modified {{flag 1}} {
    global param_values_modified

    if $flag {
	set param_values_modified 1
    } else {
	catch {unset param_values_modified}
    }
}
set dont_record_command(ic_param_set_modified) 1

## Add a new child to a given parent node.  The parent must be a multiple
## node, i.e. a container for multiple children.  The node will be given
## the initial <b>name</b> and the values specified in the list which must
## be a set of name/value pairs.

proc ic_param_add_node {parent name values} {
    global param_edit param_values param_values_modified
    
    if {[trace vinfo param_values] == ""} {
	trace variable param_values w "set param_values_modified 1; list"
    }
    
    if {[info exists param_edit(tree)] && [winfo exists $param_edit(tree)]} {
	if [info exists param_edit(create_new_node,$parent/create_new_node)] {
	    return [famboco_edit_params_create_new $parent/create_new_node \
			$name $values]
	} else {
	    return [famboco_edit_params_create_new $parent $name $values]    
	}
    } else {
	foreach {n v} $values {
	    set param_values($parent/$name,$n) $v
	}
    }
}

## Delete the given node.

proc ic_param_delete_node {node} {
    famboco_edit_params_delete "" $node
}

## List the children of the given node.  This returns values of the form
## :foo:bar:baz/baz13, unless the tail arg is 1, in which case it just
## returns baz13

proc ic_param_list_children {node {tail 0}} {
    global param_edit param_values
    
    if {[info exists param_edit(tree)] && [winfo exists $param_edit(tree)]} {
	if [$param_edit(tree) exists $node] {
	    return [$param_edit(tree) nodes $node]
	} else {
	    return ""
	}
    } elseif $tail {
	foreach ch [ic_param_node_list $node/*] {
	    set rest [string range $ch [string length $node/] end]
	    set found([lindex [split $rest :] 0]) 1
	}
    } else {
	foreach ch [ic_param_node_list $node/*] {
	    set rest [string range $ch [string length $node/] end]
	    set found($node/[lindex [split $rest :] 0]) 1
	}
	foreach ch [ic_param_node_list $node:*] {
	    set rest [string range $ch [string length $node:] end]
	    set found($node:[lindex [split $rest :] 0]) 1
	}
    }
    return [array names found]
}
set dont_record_command(ic_param_list_children) 1

## List all the node names

proc ic_param_node_list {{pat *}} {
    global param_values
    
    foreach pv [array names param_values $pat,*] {
	set found([lindex [split $pv ,] 0]) 1
    }
    return [array names found]
}
set dont_record_command(ic_param_node_list) 1

## Does a given node exist?

proc ic_param_node_exists {node} {
    global param_values
    
    return [expr {([array names param_values $node,*] != "") || 
		  ([array names param_values $node/*] != "") || 
		  ([array names param_values $node:*] != "")}]
}
set dont_record_command(ic_param_node_exists) 1

## Make up a new name (prefix followed by a number) for a child of a node.
## If prefix is - then that means just use a number

proc ic_param_unused_child_name {node {prefix ""}} {
    foreach ch [ic_param_list_children $node] {
	set found([lindex [split $ch /] 1]) 1
    }
    if {$prefix == "-"} {
	set prefix ""
    } elseif {$prefix == ""} {
	set prefix [lindex [split $node :] end]
    }
    for {set i 1} {[info exists found($prefix$i)]} {incr i} {}
    return $prefix$i
}
set dont_record_command(ic_param_unused_child_name) 1

## List the parameter values for the given node.  This returns a list of
## name/value pairs.

proc ic_param_get_values {node} {
    global param_edit param_values
    
    # This is a bit annoying.  If this is a node we haven't edited before
    # then its values will be in the param_values array and not param_edit.
    foreach pp [array names param_values $node,*] {
	set t [lindex [split $pp ,] 1]
	set v $param_values($pp)
	set ret($t) $v
    }
    
    foreach pp [array names param_edit val,$node,*] {
	set t [lindex [split $pp ,] 2]
	set v $param_edit($pp)
	set ret($t) $v
    }
    return [array get ret]
}
set dont_record_command(ic_param_get_values) 1

## Change the parameter values on the given node.  The values list must 
## contain name/value pairs.

proc ic_param_set_values {node values} {
    global param_edit param_values
    
    foreach {t v} $values {
	if [info exists param_edit] {
	    set param_edit(val,$node,$t) $v
	}
	set param_values($node,$t) $v
    }
    if {[trace vinfo param_values] == ""} {
	trace variable param_values w "set param_values_modified 1; list"
    }
}

## Rename a bunch of nodes.  If delete_non_matching is 1 then delete those
## which don't match.

proc ic_param_rename {oldprefix newprefix {delete_non_matching 0}} {
    global param_values
    
    set keys [concat [array names param_values $oldprefix,*] \
		  [array names param_values $oldprefix/*] \
		  [array names param_values $oldprefix:*]]
    set opl [string length $oldprefix]
    foreach k $keys {
	set k2 $newprefix[string range $k $opl end]
	#puts "$k -> $k2"
	set param_values($k2) $param_values($k)
	set newkey($k2) 1
	unset param_values($k)
    }
    if $delete_non_matching {
	foreach p [array names param_values] {
	    if ![info exists newkey($p)] { unset param_values($p) }
	}
    }
}

## Set all the param values.

proc ic_param_set_all {vals} {
    global param_values
    catch {unset param_values}
    array set param_values $vals
}

## Get all the param values.

proc ic_param_get_all {} {
    global param_values
    return [array get param_values]
}
set dont_record_command(ic_param_get_all) 1
