# Edit window stuff.
#
# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California

proc make_edit_window {} {
    global whoami toplevel edit_window_goes_on_bottom edit_frame

    set edit_window_goes_on_bottom 1

    edit_make_model_window_bottom
    if {[info commands edit_make_post_window_bottom] != ""} {
	edit_make_post_window_bottom
    }
}

proc edit_set_subform {w} {
    global edit_frame

    set curw [grid slaves $edit_frame]
    if {$curw != "$edit_frame.$w"} {
	if {$curw != ""} { grid forget $curw }
	if {$w != "none"} {
	    grid $edit_frame.$w -sticky nw -row 0 -column 0
	}
    }
}

proc edit_make_model_window_bottom {} {
    global shape_data drop_down_arrow model_data
    global edit_frame

    frame $edit_frame.mod
    frame $edit_frame.mod.params
    frame $edit_frame.mod.params.top
    frame $edit_frame.mod.params.shape
    frame $edit_frame.mod.params.object
    frame $edit_frame.mod.params.buts

    grid $edit_frame.mod -row 0 -column 0 -sticky nwes
    grid $edit_frame.mod.params -row 0 -column 0 -sticky nw
    grid $edit_frame.mod.params.top -row 0 -column 0 -sticky nw -padx 2 -pady 2
    grid $edit_frame.mod.params.shape -row 0 -column 1 -rowspan 4 -sticky nwes -padx 2 -pady 2
    grid $edit_frame.mod.params.object -row 1 -column 0 -sticky nw -padx 2 -pady 2
    grid $edit_frame.mod.params.buts -row 2 -column 0 -sticky nwe -padx 2 -pady 2
    grid rowconfigure $edit_frame 0 -weight 1000
    grid columnconfigure $edit_frame 0 -weight 1000
    grid rowconfigure $edit_frame.mod 0 -weight 1000
    grid columnconfigure $edit_frame.mod 0 -weight 1000

    # Top window.
    set t $edit_frame.mod.params.top
    label $t.namel -text Name -anchor w
    label $t.groupsl -text Group -anchor w
    label $t.genusl -text Type -anchor w
    label $t.sectionl -text Section -anchor w
    label $t.stypel -text Geom -anchor w
    entry $t.name -textvariable model_data(name) -width 7
    entry $t.groups -textvariable model_data(groups) -width 7
    bind $t.name <Return> edit_modify_params
    bind $t.groups <Return> edit_modify_params

    set t2 $edit_frame.mod.params.buts
    button $t2.apply -text Apply -command edit_modify_params
    button $t2.reset -text Reset -command edit_reset_params
    button $t2.edit -text Edit -command edit_current_object

    futil_menuentry_labels $t.genus current_genus \
	"edit_current_options genus" "" "" "edit_set_category genus {}"
    futil_menuentry_labels $t.section current_section \
	"edit_current_options section" "" "" "edit_set_category section {}"
    futil_menuentry_labels $t.stype current_stype \
	"edit_current_options stype" "" "" "edit_set_category stype {}"

    # Here is a useful thing.
    set shape_data(dummy) 1 ;# needed to make the following work ...
    trace variable shape_data(plane) w fix_shape_data
    trace variable shape_data(plane_name) w fix_shape_data
    trace variable shape_data(axis) w fix_shape_data
    trace variable shape_data(axis_name) w fix_shape_data
    trace variable shape_data(diff_flag) w fix_diff_flag_label

    # try more stuff
    set model_data(dummy) 1 ;# needed to make the following work ...
    #    trace variable model_data(plane) w fix_model_data
    trace variable model_data(plane) w fix_model_data
    trace variable model_data(diff_flag) w fix_diff_flag_label_model
}

proc edit_scroll_key {dir} {
    global current_phase current_mtype
    global edit_frame

    if {($current_phase != "model") || ($current_mtype == "")} return

    set ww [focus]
    if {$ww != ""} {
	switch [winfo class $ww] {
	    Entry - Text return
	}
    }

    set lb $edit_frame.mod.objects.s.list
    set cur [$lb curselection]
    set size [$lb size]

    if {$cur == ""} return
    set next [expr $cur + $dir]
    if {$next == -1} { set next [expr $size - 1] }
    if {$next == $size} { set next 0 }
    edit_select_action $lb $next
}

proc edit_update_mtype {type} {
    global domain is_win tk_version mainwindow_menubar
    global edit_frame

    if ![winfo exists $edit_frame.mod.buttons] return

    set newstyle [expr {[info exists mainwindow_menubar] &&
			$mainwindow_menubar}]

    switch $type {
	domain {
	    set sl [grid slaves $edit_frame]
	    if {$sl != "$edit_frame.mod"} {
		if {$sl != ""} {
		    grid forget $sl
		}
		grid $edit_frame.mod -row 0 -column 0
	    }
	    if !$newstyle {
		pack forget $edit_frame.mod.objects.s
	    }
	    # edit is okay
	    foreach e {delete new unselect copy active} {
		$edit_frame.mod.buttons.$e configure -state disabled
	    }
	    $edit_frame.mod.buttons.move configure -state normal
	    foreach b {ind nop ent} {
		$edit_frame.mod.motion.$b configure -state disabled
		if {!$is_win || ($tk_version < 8.0)} {
		    $edit_frame.mod.motion.$b configure -selectcolor \
			[$edit_frame.mod.motion cget -background]
		}
	    }
	    $edit_frame.mod.params.buts.cfrom configure -state disabled
	    model_set_current $domain
	}
	material {
	    foreach sl [grid slaves $edit_frame] {
		grid forget $sl
	    }
	    mat_edit_form
	}
	profile {
	    foreach sl [grid slaves $edit_frame] {
		grid forget $sl
	    }
	    prof_edit_form
	}
	default {
	    set sl [grid slaves $edit_frame]
	    if {$sl != "$edit_frame.mod"} {
		if {$sl != ""} {
		    grid forget $sl
		}
		grid $edit_frame.mod -row 0 -column 0
	    }
	    pack $edit_frame.mod.objects.s -fill both
	    foreach e {edit delete new unselect copy move active} {
		$edit_frame.mod.buttons.$e configure -state normal
	    }
	    foreach b {ind nop ent} {
		$edit_frame.mod.motion.$b configure -state normal
		if {!$is_win || ($tk_version < 8.0)} {
		    $edit_frame.mod.motion.$b configure -selectcolor #b03060
		}
	    }
	    if {$type == "part"} {
		$edit_frame.mod.params.buts.cfrom configure -state disabled
	    } else {
		$edit_frame.mod.params.buts.cfrom configure -state normal
	    }
	}
    }
}

proc fix_shape_data {var sub op} {
    global shape_data current_shape current_object incline_angle_info
    global no_fix_shape_data

    if {[info exists no_fix_shape_data] || ($current_object == "") ||
	($current_shape == "") || ($sub == "")} return

    set sh $current_shape

    #edit_modify_params
    #if {$sub == "axis"} { edit_modify_params }

    set val $shape_data($sub)

    switch "$sub $val" {
	"plane 0"         { set shape_data(plane_name) yz }
	"plane 1"         { set shape_data(plane_name) xz }
	"plane 2"         { set shape_data(plane_name) xy }
	"plane -1"        { set shape_data(plane_name) none }
	"plane_name yz"   { set shape_data(plane) 0 }
	"plane_name xz"   { set shape_data(plane) 1 }
	"plane_name xy"   { set shape_data(plane) 2 }
	"plane_name none" { set shape_data(plane) -1 }
	"axis 0"          { set shape_data(axis_name) x }
	"axis 1"          { set shape_data(axis_name) y }
	"axis 2"          { set shape_data(axis_name) z }
	"axis_name yz"    { set shape_data(axis) 0 }
	"axis_name xz"    { set shape_data(axis) 1 }
	"axis_name xy"    { set shape_data(axis) 2 }
    }

    set fn app_clean_up_[$current_object getval obtype]
    switch $sub {
	plane_name {
	    if [catch {$sh getval plane} pl] return
	    if {$shape_data(plane) == -1} {
		$sh setval plane -1 height 0
		edit_reset_params 0

	    } elseif {$shape_data(plane) != $pl} {
		if {$pl == -1} {
		    $sh setval plane 0
		} else {
		    array set foo { 0 1 1 1 2 1 }
		    unset foo($shape_data(plane))
		    unset foo($pl)
		    set ax [array names foo] ;# clever
		    if {$shape_data(plane) == ($pl + 1) % 3} {
			set rr 270
		    } else {
			set rr 90
		    }


		    set appfunc [info commands app_transform_[[$sh get -object] getval obtype]]
		    if {$appfunc != ""} {
			$appfunc $sh rotate $ax $rr ""
		    } else {
			$sh rotate $ax $rr ""
		    }
		}
		if {[info commands $fn] != ""} { $fn $current_object }
		undo_record_change_shape $sh \
		    [list [list plane $pl $shape_data(plane)]]
		edit_reset_params 0
		update_decorations $sh
		db_dirty mesh
	    }
	}
	axis_name {
	    if [catch {$sh getval axis} axis] return
	    if {$shape_data(axis) != $axis} {
		array set foo { 0 1 1 1 2 1 }
		unset foo($shape_data(axis))
		unset foo($axis)
		set ax [array names foo] ;# clever
		if {$shape_data(axis) == ($axis + 1) % 3} {
		    set rr 270
		} else {
		    set rr 90
		}
		$sh rotate $ax $rr ""
		if {[info commands $fn] != ""} { $fn $current_object }
		undo_record_change_shape $sh \
		    [list [list axis $axis $shape_data(axis)]]
		edit_reset_params 0
		update_decorations $sh
		db_dirty mesh
	    }
	}
    }
    if [info exists shape_data(axis)] {
	set a1 [expr ($shape_data(axis) + 1) % 3]
	set a2 [expr ($shape_data(axis) + 2) % 3]
	set incline_angle_info "(from [lindex {X Y Z} $a1] to [lindex {X Y Z} $a2])"
    }
}

proc fix_diff_flag_label {args} {
    global shape_data diff_flag_windows diff_flag_grid_info

    if {![info exists shape_data(diff_flag)] || \
	    ($shape_data(diff_flag) == "")} return

    switch $shape_data(diff_flag) {
	0 { set want "xs ys zs xe ye ze" }
	1 { set want "xs ys zs xd yd zd" }
	2 { set want "xs ys zs xd2 yd2 zd2 rotate_angle" }
    }

    if [info exists diff_flag_windows] {
	foreach wins $diff_flag_windows {
	    foreach w $wins {
		foreach sub {xs ys zs xe ye ze xd yd zd xd2 yd2 zd2 rotate_angle} {
		    set ww $w$sub
		    if ![winfo exists $ww] continue
		    if {[lsearch $want $sub] >= 0}  {
			if [info exists diff_flag_grid_info($ww)] {
			    eval grid $ww $diff_flag_grid_info($ww)
			    unset diff_flag_grid_info($ww)
			}
		    } else {
			set inf [grid info $ww]
			if {$inf != ""} {
			    grid forget $ww
			    set diff_flag_grid_info($ww) $inf
			}
		    }
		}
	    }
	}
    }
    # fire off the traces to blank out non-used fields
    if [info exists shape_data(axis)] {
	set shape_data(axis) $shape_data(axis)
    }
}

proc edit_object_form {w} {
    global current_mtype_title small_screen_hack
    global edit_frame

    if $small_screen_hack { set lsize 5 } else { set lsize 8 }

    frame $edit_frame.mod.objects.s
    label $edit_frame.mod.objects.s.label -textvariable current_mtype_title \
	-anchor w
    listbox $edit_frame.mod.objects.s.list -relief sunken -borderwidth 2 \
	-yscroll "$edit_frame.mod.objects.s.scroll set" -background white \
	-width 10 -height $lsize -exportselection 0 -selectmode single
    scrollbar $edit_frame.mod.objects.s.scroll -command \
	"$edit_frame.mod.objects.s.list yview" -background #cdb79e

    pack $edit_frame.mod.objects.s.label -side top -fill x -anchor w
    pack $edit_frame.mod.objects.s.list -side left -fill both -expand 1
    pack $edit_frame.mod.objects.s.scroll -side right -fill y

    bind $edit_frame.mod.objects.s.list <Button-1> "edit_select_action %W \[%W nearest %y\]"
    bind $edit_frame.mod.objects.s.list <Double-Button-1> edit_current_object
}

proc edit_select_action {w pos} {
    global model_container edit_select_command

    #if {[$w itemconfigure $pos -background] == "yellow"} return
    set name [string trim [$w get $pos]]
    if {$name != ""} {
	set obj [$model_container get_name $name]
	if [info exists edit_select_command] {
	    uplevel #0 eval "$edit_select_command $obj"
	} else {
	    model_set_current $obj
	}
    }
}

proc edit_selection_set {obj {list ""}} {
    global current_mtype
    global edit_frame
    if {$current_mtype == "material"} {
	set list $edit_frame.mat.objects.list
    } elseif {$current_mtype == "profile"} {
	set list $edit_frame.prof.profiles.list
    } elseif {$list == ""} {
	set list $edit_frame.mod.objects.s.list
    }
    if ![winfo exists $list] return
    $list selection clear 0 end

    if {($obj == "") || ![winfo exists $list]} return

    set obname [$obj getval name]
    set no [$list size]
    for {set i 0} {$i < $no} {incr i} {
	if {[string trim [$list get $i]] == $obname} {
	    $list selection set $i
	    $list see $i
	    return
	}
    }
}

proc edit_selection_put_type {type} {
    global job_listsort
    global edit_frame

    set list $edit_frame.mod.objects.s.list
    if ![winfo exists $list] return

    $list delete 0 end
    foreach ch [db_list_for_selection $type] {
	switch [lindex $ch 0] {
	    title {
		set ee [$list index end]
		set n [$list insert end [lindex $ch 1]]
		$list itemconfigure $ee -background yellow
	    }
	    obj {
		$list insert end [lindex $ch 1]
	    }
	}
    }
}

# This is wrong *****************************************

proc edit_selection_add {obj {list ""}} {
    global edit_frame

    if {$list == ""} { set list $edit_frame.mod.objects.s.list }
    if ![winfo exists $list] return
    set obname [$obj getval name]
    $list insert end $obname
    edit_selection_sort $list
}

proc edit_selection_delete {obj {list ""}} {
    global edit_frame

    if {$list == ""} { set list $edit_frame.mod.objects.s.list }
    if ![winfo exists $list] return
    set obname [$obj getval name]
    set no [$list size]
    for {set i 0} {$i < $no} {incr i} {
	if {[string trim [$list get $i]] == $obname} {
	    $list delete $i
	    return
	}
    }
}

proc edit_selection_rename {oname nname {list ""} {resort 1}} {
    global job_listsort
    global edit_frame

    if {$list == ""} { set list $edit_frame.mod.objects.s.list }
    if ![winfo exists $list] return
    set no [$list size]
    for {set i 0} {$i < $no} {incr i} {
	if {[$list get $i] == $oname} {
	    $list delete $i
	    $list insert $i $nname
	    if {$resort && ($job_listsort == "alpha")} {
		edit_selection_sort
	    }
	    return
	}
    }
}

proc edit_listsort_compare {p1 p2} {
    global job_listsort

    if {$job_listsort == "alpha"} {
	return [alpha_compare_names [lindex $p1 0] [lindex $p2 0]]
    } else {
	return [expr {[lindex $p1 1] - [lindex $p2 1]}]
    }
}

proc edit_selection_sort {{list ""}} {
    global job_listsort model_container current_object
    global edit_frame

    if {$list == ""} { set list $edit_frame.mod.objects.s.list }
    if ![winfo exists $list] return
    set no [$list size]
    set stuff ""
    for {set i 0} {$i < $no} {incr i} {
	set name [$list get $i]
	set obj [$model_container get_name $name]
	if {$job_listsort == "alpha"} {
	    lappend stuff [list $name]
	} else {
	    lappend stuff [list $name [$obj getval $job_listsort ""]]
	}
    }
    set stuff [lsort -command edit_listsort_compare $stuff]
    $list delete 0 end
    foreach s $stuff {
	$list insert end [lindex $s 0]
    }
    edit_selection_set $current_object
}

# -------------------------------------------

proc edit_motion_form {w} {
    global type_name type_name_button tdv_nonuniform_scale use_indomain_button

    set dn domain
    if [info exists type_name(domain)] { set dn $type_name(domain) }
    if [info exists type_name_button(domain)] { set dn $type_name_button(domain) }

    label $w.alab -text "Motion allowed:"
    frame $w.afr
    checkbutton $w.afr.x -text X -variable shape_x_motion
    checkbutton $w.afr.y -text Y -variable shape_y_motion
    checkbutton $w.afr.z -text Z -variable shape_z_motion
    pack $w.afr.x $w.afr.y $w.afr.z -side left -fill both -expand 1

    checkbutton $w.ind -text "In $dn" -variable shape_indomain
    checkbutton $w.nop -text "No penetrate" -variable shape_nopenetrate
    checkbutton $w.ent -text "Move group" -variable shape_movegroup

    checkbutton $w.gridx -text "X grid" -variable shape_x_grid_on
    checkbutton $w.gridy -text "Y grid" -variable shape_y_grid_on
    checkbutton $w.gridz -text "Z grid" -variable shape_z_grid_on
    foreach c {x y z} {
	entry $w.grid${c}v -width 6 -justify right -textvariable \
	    shape_${c}_grid
	trace variable shape_${c}_grid_on w "\
		if \$shape_${c}_grid_on { \
		    $w.grid${c}v configure -state normal -fg black \
	        } else { \
	            $w.grid${c}v configure -state disabled -fg gray \
	        }; list"
    }

    set tabring "$w.gridxv $w.gridyv $w.gridzv"

    blt_table $w $w.alab 1,1 -columnspan 2 -anchor c
    blt_table $w $w.afr 2,1 -columnspan 2 -anchor w -fill both
    if [info exists use_indomain_button] {
	blt_table $w $w.ind 3,1 -columnspan 2 -anchor w
    }
    blt_table $w $w.nop 4,1 -columnspan 2 -anchor w
    blt_table $w $w.ent 5,1 -columnspan 2 -anchor w

    blt_table $w $w.gridx 10,1 -anchor w
    blt_table $w $w.gridy 11,1 -anchor w
    blt_table $w $w.gridz 12,1 -anchor w
    blt_table $w $w.gridxv 10,2 -fill x
    blt_table $w $w.gridyv 11,2 -fill x
    blt_table $w $w.gridzv 12,2 -fill x
    blt_table_row $w configure 13 -height 2

    set_tabring $tabring
}

proc edit_buttons_form {w} {
    global current_object small_screen_hack

    set two 2
    if $small_screen_hack { set two 0 }

    checkbutton $w.active -text Active -variable edit_current_active \
	-command "edit_toggle_current_active" -anchor w

    #button $w.const -text Constr -command edit_constraints
    button $w.new -text New -command "edit_new_button {}"
    button $w.delete -text Delete -command "trash_add \$current_object"
    button $w.edit -text Edit -command edit_current_object
    button $w.copy -text Copy -command "edit_move 1"
    button $w.move -text Move -command "edit_move 0"
    button $w.unselect -text Unsel -command "model_set_current {}"
    button $w.backt -text "Back to top" -command "part_switch_model top" \
	-background \#FF8000 -activebackground \#FFA080

    grid $w.active   -row 1 -column 0 -padx $two -pady $two -sticky ew \
	-columnspan 2

    grid $w.new      -row 2 -column 0 -padx $two -pady $two -sticky ew
    grid $w.edit     -row 3 -column 0 -padx $two -pady $two -sticky ew
    grid $w.copy     -row 4 -column 0 -padx $two -pady $two -sticky ew

    grid $w.delete   -row 2 -column 1 -padx $two -pady $two -sticky ew
    grid $w.unselect -row 3 -column 1 -padx $two -pady $two -sticky ew
    grid $w.move     -row 4 -column 1 -padx $two -pady $two -sticky ew

    grid_uniform_cols $w {edit delete new unselect copy move active}

    #trace variable current_object w "edit_buttons_active; list"
    #edit_buttons_active
}

proc edit_back_to_top {on} {
    global small_screen_hack
    global edit_frame

    if ![winfo exists $edit_frame.mod.buttons.backt] return

    if $on {
	if $small_screen_hack { set two 0 } else { set two 2 }
	grid $edit_frame.mod.buttons.backt -row 5 -column 0 \
	    -padx $two -pady $two -sticky ew -columnspan 2
    } else {
	catch {grid forget $edit_frame.mod.buttons.backt}
    }
}

# -----------------------------------------------

proc edit_update_active {obj {a ""}} {
    global current_object model_data
    
    if {$a == ""} {
	set a [$obj si_value active] 
    } else {
	$obj setval active $a
    }
    
    # If it's already active or not then don't do this
    set sh [db_shapes $obj 0]
    if {($sh != "") && ([$sh get -visible] == $a)} return
    
    make_visible $obj $a
    reconfigure_object $obj
    if {[info command app_after_object_change_active] != ""} {
	app_after_object_change_active $obj
    }
    tree_changeactive_object $obj
    undo_record_change_active $obj
    if {$obj == $current_object} {
	set model_data(active) [$obj si_expr active]
    }
    db_dirty mesh
}

proc edit_toggle_current_active {{obj ""} {reverse 0} {undo 1}} {
    global current_object edit_current_active model_data

    if {$obj == ""} { set obj $current_object }
    if {$obj == ""} return
    
    if [string match *\$* [$obj getval active]] return
    
    set a [$obj si_value active]
    
    if {([info command app_can_object_change_active] != "") &&
	![app_can_object_change_active $obj]} {
	user_error "That object can't be inactivated"
	set edit_current_active $a
	return
    }
    
    if $reverse {
	set want [expr !$a]
    } else {
	set want $edit_current_active
    }
    if {$a != $want} {
	edit_update_active $obj $want
	if $undo { undo_record_change_active $obj }
    }
    if {$a != $want} {
	db_dirty mesh
    }
}

proc edit_toggle_current_visible {{obj ""} {reverse 0}} {
    global current_object edit_current_visible model_data

    if {$obj == ""} { set obj $current_object }
    if {$obj == ""} return

    set v [expr {[$obj getval obj_shading ""] != "Invisible"}]
    if $reverse {
	set want [expr !$v]
    } else {
	set want $edit_current_visible
    }
    if {$v != $want} {
	if $want {
	    $obj setval obj_shading default
	    make_visible $obj 1
	} else {
	    $obj setval obj_shading Invisible
	    make_visible $obj 0
	}
	reconfigure_object $obj
	tree_changevisible_object $obj
    }
    if {$obj == $current_object} {
	set model_data(obj_shading) [$obj getval obj_shading]
    }
}

proc edit_object_to_var {obj var uvar} {
    global $var $uvar

    $obj to_var $var $uvar

    # Make sure that we don't have any pointers to shapes left over from
    # the previous objects
    foreach i [array names $var] {
	if [string match *_shape $i] {
	    unset ${var}($i)
	}
    }
}

# Return value: 0 means no object, 1 means ok, 2 means it had to move it
# This subroutine should never be reentrant so we will be careful here.

proc edit_modify_params {{ask_if_cancel 1}} {
    global in_edit_modify_params errorInfo
    if [info exists in_edit_modify_params] return
    set in_edit_modify_params 1
    set err [catch "edit_modify_params_sub $ask_if_cancel" ret]
    unset in_edit_modify_params
    if $err { error $errorInfo }
        
    return $ret
}

proc edit_modify_params_sub {ask_if_cancel} {
    global current_shape current_object edit_current_active
    global model_data shape_data model_container
    global object_params_affect_mesh object_params_affect_sections
    global object_params_affect_graphics
    global object_subtypes trash_container error_if_dirty
    global model_data_units shape_data_units model_container_root
    global editing_material_definition job_all_fixvals named_point
    global warned_about_external_assembly is_iceboard
    
    if {$current_object == ""} { return 0 }

    set what_dirty ""

    set obj $current_object
    set sh $current_shape
    set obtype [$obj getval obtype]

    if {[info commands app_check_params_$obtype] != "" &&
        [catch {app_check_params_$obtype $obj} msg]} {
        user_error $msg
        return 0
    }

    set model_data(name) [string trim $model_data(name)]
    if {$model_data(name) == "*multiple*"} { return 0 }

    set matlib ""
    if ![info exists editing_material_definition] {
	set matlib [$current_object getval mat_lib_path ""]
    }
    if {($matlib != "") && [lindex [library_name_and_info $matlib] 2]} {
	edit_reset_params
	return 0
    }
    
    # If this is inside an external assembly don't allow any changes to be made.
    # This may give too many warnings (if no changes are actually made) but better too
    # many than too few
    for {set par [$obj get -model_container]} {$par != ""} {set par [$par get -model_container]} {
	if {[$par getval part_type] == "external"} {
	    if ![info exists warned_about_external_assembly($obj)] {
		set warned_about_external_assembly($obj) 1
		mess "Warning: not changing properties of an object ([$obj getval name]) in an external assembly\n" red
	    }
	    edit_reset_params
	    return 0
	}
    }

    set obname1 $model_data(name)
    
    if {($model_data(name) != [$obj getval name]) && [$obj getval no_name_modify 0]} {
	set model_data(name) [$obj getval name]
	mess "Changing \"$obname1\" back to \"[$obj getval name]\" because that object must have this name.\n" red
    }
    
    if [regsub -all / $model_data(name) _ model_data(name)] {
	mess "Changing \"$obname1\" to \"$model_data(name)\" because\
the / character is no longer allowed in names\n" red
    }
    set ch0 [string index $model_data(name) 0]
    if 0 {
	# why is this here?   I don't remember
	if {[string first $ch0 "0123456789"] >= 0} {
	    set model_data(name) _$model_data(name)
	    mess "Changing \"$obname1\" to \"$model_data(name)\" because\
the names can't begin with '$ch0'\n" red
	}
    }
    
    # First see about the name.
    set on [$obj getval name]
    set nn $model_data(name)
    if {[$obj getval no_geometry_modify 0] && ($nn != $on)} {
	mess "Can't modify the name of this object\n" red
	set model_data(name) $on
	set nn $on
    }
    busy 1

    set islib 0 ;# [expr {[$obj getval mat_lib_path ""] != ""}]

    if {!$islib && ($nn != $on)} {
	set nn [edit_rename_object $obj $on $nn]
	set old_object_val(name) $on
	set what_dirty model
    }

    if [info exists model_data(fixvals)] {
	$obj setval fixvals $model_data(fixvals)
    }
    if [$obj getval no_geometry_modify 0] {
	# Just don't let it happen
	$current_shape to_var shape_data shape_data_units
    }
    
    set oldpos ""
    set newpos ""
    
    set sch ""
    if {$sh != ""} {
	set oldpos [$sh getval min]
	
	# This is an ugly hack.
	set shtype [$sh get -shtype]
	if {($shtype == "polygon") || ($shtype == "pipe")} {
	    set nnv $shape_data(nverts)
	    set onv [$sh get -nverts]
	    if {$nnv != $onv} {
		set old_shape_val(nverts) $onv
		$sh setval nverts $nnv
	    }
	}
	if {[info command app_after_change_${shtype}_num_sides] != ""} {
	    after idle app_after_change_${shtype}_num_sides
	}
	switch $job_all_fixvals {
	    all  { set fv 1 }
	    none { set fv 0 }
	    per  { set fv [$obj getval fixvals 0] }
	}
	$sh configure -fixvals $fv
	set sch [$sh from_var shape_data old_shape_val \
		     shape_data_units]

 	# Sometimes we get roundoff / unit problems here.  Try to
 	# avoid these ...
 	set new_sch ""
 	foreach s $sch {
 	    if ![info exists shape_data_units($s)] {
		lappend new_sch $s
		continue
	    }

 	    set ov $old_shape_val($s)
 	    set nv [unit_convert $shape_data($s) $shape_data_units($s) 0 0]
 	    if {($nv != "") && ($nv != 0) && ![string match {*$*} $ov] && ![string match {*$*} $nv] && ![string match {*ambient*} $ov] && ![string match {*ambient*} $nv] && ![string match {*default*} $ov] && ![string match {*default*} $nv]} {
 		set rat [expr abs($ov / ($nv + 0.0) - 1.0)]
 		if {$rat < 1e-5} {
 		    # call it roundoff
		    #puts "roundoff: $rat"
 		} else {
 		    lappend new_sch $s
 		}
 	    } else {
 		lappend new_sch $s
 	    }
 	}
 	set sch $new_sch
	$sh to_var shape_data shape_data_units
	if [catch {$sh update_expression_values}] {
	    user_error "There is a problem with the parameters for \"[$obj getval name]\" [$sh get -name] - please check them"
	}
	if {[$sh get -shtype] == "container"} update_container_bbvars
	
	set newpos [$sh getval min]
    }
    # These are things we never want to update in this way.
    foreach v {creation_order} {
	catch {unset model_data($v)}
    }

    set mch [$obj from_var model_data old_object_val \
		 model_data_units]
    if [info exists error_if_dirty] {
	puts "sch $sch mch $mch"
	foreach m $mch {
	    puts "$m : $old_object_val($m) -> $model_data($m)"
	}
	foreach m $sch {
	    puts "$m : $old_shape_val($m) -> $shape_data($m)"
	}
    }

    # -------------------------------------------------

    # Sometimes we get roundoff / unit problems here.  Try to
    # avoid these ...
    set new_mch ""
    foreach m $mch {
	#puts "1 $m"
	if {![info exists model_data_units($m)] ||
	    ![info exists old_object_val($m)]} {
	    lappend new_mch $m
	    continue
	}

	set ov $old_object_val($m)
	set nv [unit_convert $model_data($m) $model_data_units($m) 0 0]
	#puts "NV $nv OV $ov"
	#puts "unit_convert $model_data($m) $model_data_units($m) 0 0"
	if {($nv != "") && ($nv != 0) && ($ov != "") && ($ov != 0) &&
	    ![string match {*$*} $ov] && ![string match {*$*} $nv] &&
	    ![string match {*ambient*} $ov] && ![string match {*ambient*} $nv] && ![string match {*default*} $ov] && ![string match {*default*} $nv]} {
	    set rat [expr abs($ov / ($nv + 0.0) - 1.0)]
	    if {$rat < 1e-5} {
		# call it roundoff
		# puts "roundoff: $rat"
	    } else {
		lappend new_mch $m
	    }
	} else {
	    lappend new_mch $m
	}
    }
    set mch $new_mch

    # -------------------------------------------------

    if [info exists object_subtypes($obtype)] {
	foreach st $object_subtypes($obtype) {
	    if {[lsearch $mch [lindex $st 0]] >= 0} {
		tree_changepos_object $obj subtype
		break
	    }
	}
    }

    if {($sch != "") && ($sch != "diff_flag")} {
	set what_dirty mesh
    } elseif {$mch != ""} {
 	#foreach m $mch { puts "$m : $old_object_val($m) -> $model_data($m)" }
	set what_dirty model
	foreach m $mch {
	    if {[info exists object_params_affect_mesh($obtype,$m)] || \
		    [info exists object_params_affect_mesh(all,$m)] || \
		    [info exists object_params_affect_mesh($obtype,all)]} {
		set what_dirty mesh; break
	    }
	}
    }
    
    if {[lsearch $mch creation_order] >= 0} {
	tree_reposition_one_object $obj
    }

    if {([lsearch $mch mat_subtype] >= 0) || ([lsearch $mch mat_type] >= 0)} {
	tree_reparent_objects $obj
    }
    # This is a hack to deal with the fact that fans have two different
    # places where internal radius is kept.  Must fix it.
    if {($obtype == "fan") && ([lsearch $sch iradius] >= 0)} {
	lappend mch iradius
    }
    # Now toss in the undo stuff.
    set vals ""
    foreach v [array names old_shape_val] {
	set nv $shape_data($v)
	if [info exists shape_data_units($v)] {
	    set nv [unit_convert $nv $shape_data_units($v) 0 0]
	}
	lappend vals [list $v $old_shape_val($v) $nv]
    }

    if {$vals != ""} { undo_record_change_shape $sh $vals }
    set vals ""
    foreach v [array names old_object_val] {
	if [info exists model_data_units($v)] {
	    set nuval [unit_convert $model_data($v) $model_data_units($v) 0]
	} else {
	    set nuval $model_data($v)
	}
	lappend vals [list $v $old_object_val($v) $nuval]
    }
    if {$vals != ""} { undo_record_change_object $obj $vals $on }

    if {[info procs app_clean_up_$obtype] != ""} {
	mess_start_saving
    	app_clean_up_$obtype $obj
	set mess [mess_end_saving]
	#catch {unset model_data}
	edit_object_to_var $obj model_data model_data_units
	
	set red ""
	foreach {m c} $mess {
	    if {$c == "red"} { append red $m }
	}

	if {$ask_if_cancel && ($red != "")} {
	    set mess "The following problems were found:\n\n$red\nCancel the change?"
	    if ![tk_dialog .no_change "Problems" $mess "" -1 Yes No] {
		undo_action
		busy 0
		return 1
	    }
	}
    }

    # Check the active and group values now ...

    if {[$obj si_value active] != $edit_current_active} {
	set edit_current_active [$obj si_value active]
	make_visible $obj $edit_current_active
	tree_changeactive_object $obj
	set what_dirty mesh
    }

    if {[info exists old_object_val(groups)] && \
	    [info exists model_data(groups)] && \
	    ($old_object_val(groups) != $model_data(groups))} {
	db_put_in_groups $obj $old_object_val(groups) \
	    $model_data(groups)
    }
    set vis 1
    if {[info exists model_data(obj_shading)] &&
	($model_data(obj_shading) == "Invisible")} { set vis 0 }
    
    set graphics_changed [expr {$what_dirty == "mesh"}]
    if !$graphics_changed {
	foreach m $mch {
	    if {[info exists object_params_affect_graphics($obtype,$m)] || \
		    [info exists object_params_affect_graphics(all,$m)] || \
		    [info exists object_params_affect_graphics($obtype,all)]} {
		set graphics_changed 1; break
	    }
	}
    }
    
    if $graphics_changed {
	foreach sh [db_shapes $obj] {
	    update_decorations $sh $vis
	    # if {[info commands app_graphparams_$obtype] != ""}
	    shape_configure $sh
	    
	    set ret [$sh verify general]
	    if {$ret != ""} { user_error "Warning: $ret" }
	}
    }

    if {[info commands app_verify_$obtype] != ""} {
	set ret [app_verify_$obtype $obj]
	if {$ret != ""} { mess "Warning: $ret\n" red }
    }
    
    profile_changepos_object $obj $oldpos $newpos
    
    # Now make sure the objects are inside the domain, or the domain is
    # outside the objects.
    set out [edit_check_outside $obj 1]
    if $out {
	edit_reset_params
	if {$out == 2} { set ret 2 } else { set ret 0 }
    } else {
	set ret 1
    }

    switch $obtype {
	profile {
	    if [info exists use_profile_display_properties] {
		# Now see if we need to redisplay the objects.
		set upd 0
		foreach v $vals {
		    if [string match obj_* $v] { set upd 1; break }
		}
		if $upd {
		    foreach sub [objects_with_profile [$obj getval name]] {
			reconfigure_object $obj
		    }
		}
	    }
	    
	}
	material {
	    mat_edit_update_subtype
	    
	    if [info exists use_material_display_properties] {
		# Now see if we need to redisplay the objects.
		set upd 0
		foreach v $vals {
		    if [string match obj_* $v] { set upd 1; break }
		}
		if $upd {
		    foreach sub [objects_with_material [$obj getval name]] {
			reconfigure_object $obj
		    }
		}
	    }
	}
	part {
	    foreach sub [$obj list_contents] {
		reconfigure_object $sub
	    }
	}
    }
    
    foreach m $mch {
	if {[info exists object_params_affect_sections($obtype,$m)] || \
		[info exists object_params_affect_sections($obtype,all)]} {
	    edit_check_sections_changed
	    break
	}
    }
    # Just make sure it prompts for any new variables
    foreach m $mch { catch {$obj si_value $m} }
    
    busy 0

    if {$what_dirty != ""} {
	if {$matlib != ""} {
	    mat_save_back_to_library $matlib
	}
	db_dirty $what_dirty
    }
    
    return $ret
}

proc edit_rename_object {obj on nn} {
    global trash_container model_data model_container_root current_object
    global named_point model_container
    
    if {$on == $nn} { return "" }
    
    set obtype [$obj getval obtype]
    set update_md [expr {$obj == $current_object}]
    
    # Prevent reuse of an existing name.
    if {[db_get_name $nn] != ""} {
	set nn2 [$model_container_root new_name $nn]
	mess "Name \"$nn\" is already used - renaming to \"$nn2\"\n" red
	set nn $nn2
	if $update_md {
	    set model_data(name) $nn2
	}
    } 	    
    
    if {[$trash_container get_name $nn 1] != ""} {
	set nn2 [$trash_container new_name $nn]
	mess "Name \"$nn\" is used by an object in the trash - renaming to \"$nn2\"\n" red
	mess "    If you empty the trash you can re-use the name.\n" red
	set nn $nn2
	set model_data(name) $nn2
    }
    
    # Update the selection window.
    set par [$obj get -model_container]
    if {[$par get_name $on] != ""} {
	$par remove $on
	$par add $nn $obj
    } else {
	# for removing a material from an assembly
	set root_model_container [part_get_root]
	$root_model_container remove $on
	$root_model_container add $nn $obj
    }
    
    $obj setval name $nn
    
    edit_selection_rename $on $nn
    if {$obtype != "domain"} {
	relabel_shapes $obj
    }
    
    tree_rename_object $obj $nn

    if 0 {
	# Update a monitor point that has the same name
	if [info exists named_point(${on})] {
	    set named_point(${nn}) [set named_point(${on})]
	    unset named_point(${on})
	    # want to update the tree display, by renaming the object
	    tree_named_point_rename $on $nn
	    named_point_config_shape [db_shapes $obj]
	}
    }
    
    
    if {$obtype == "material"} {
	mat_rename $on $nn
    }
    return $nn
}

# This function can be called if some stuff about the object has changed and we
# want to check and update everything.  *** should be called by the above
# function also ***

proc edit_update_object {obj} {
    global model_container
    global object_params_affect_mesh object_params_affect_sections 
    global object_subtypes
    global model_container_root

    set obtype [$obj getval obtype]
    set obname [$obj getval name]
    if [regsub -all / $obname _ obname] {
	mess "Changing \"[$obj getval name]\" to \"$obname\" because\
the / character is no longer allowed in names\n"
	$obj setval name $obname
    }

    relabel_shapes $obj
    tree_rename_object $obj $obname
    tree_reposition_one_object $obj

    if {[info procs app_clean_up_$obtype] != ""} {
    	app_clean_up_$obtype $obj
    }

    make_visible $obj [$obj si_value active 1]

    foreach sh [db_shapes $obj] {
 	update_decorations $sh [$obj getval visible 1]
	shape_configure $sh

	set ret [$sh verify general]
	if {$ret != ""} { mess "Warning: $ret\n" red }
    }

    if {[info commands app_verify_$obtype] != ""} {
	set ret [app_verify_$obtype $obj]
	if {$ret != ""} { mess "Warning: $ret\n" red }
    }
    
    db_dirty mesh
}

# If we are setting a new variable in an object, just adding it to the model
# data field is not enough since the object will only update the variables
# it knows about.  Therefore we have to set it in the object also with a
# value of "" so that it will pull it in the next time edit_modify_params is
# called.  If val == "" that means unset it

proc set_model_data_and_obj {var val} {
    global model_data current_object
    
    if {$val != ""} {
	if ![$current_object checkval $var] {
	    $current_object setval $var ""
	}
	set model_data($var) $val
    } else {
	catch {$current_object unset $var}
	catch {unset model_data($var)}
    }
}

proc set_model_data_and_obj_units {var val} {
    global model_data_units current_object
    
    if {$val != ""} {
	$current_object setunits $var $val
	set model_data_units($var) $val
    } else {
	catch {unset model_data_units($var)}
    }
}

proc edit_check_outside {obj undo_if_cancel} {
    global domain type_name
    global dont_move_sections_individually

    set ttol [grid_get_ttol]

    if ![$obj si_value active] { return 0 }
    if [$obj getval no_geometry_modify 0] { return 0 }

    set domsh [db_shapes $domain]
    if {[llength $domsh] != 1} { return 0 } ;# for now
    if {[$domsh get -shtype] == "none"} { return 0 }

    set outside ""
    if {$obj == $domain} {
	foreach ob [db_list_all] {
	    if [$ob getval no_geometry_modify 0] continue
	    foreach sh [db_shapes $ob] {
		if {[$sh get -shtype] == "none"} continue
		if [$domsh check_outside $sh $ttol] {
		    if [$ob getval move_sections_together 0] {
			lappend outside $ob 0
			break
		    } else {
			lappend outside $sh 1
		    }
		}
	    }
	}

    } else {
	foreach sh [db_shapes $obj] {
	    if {[$sh get -shtype] == "none"} continue
	    if [$domsh check_outside $sh $ttol] {
		if [$obj getval move_sections_together 0] {
		    lappend outside $obj 0
		    break
		} else {
		    lappend outside $sh 1
		}
	    }
	}
    }

    if {$outside != ""} {
	set can_resize 1
	foreach {out issh} $outside {
	    if $issh {
		set out [$out get -object]
	    }
	    set type [$out getval obtype]
	    # ($type == "part") ||
	    if {[info exists dont_move_sections_individually($type)]} {
		set can_resize 0
		break
	    }
	}

	set dn $type_name(domain)
	regsub -all _ $dn " " dn

	if $can_resize {
	    set buts [list \
			  {{Allow out} {form_done .obj_out 0}} \
			  {Move {form_done .obj_out 1}} \
			  {Resize {form_done .obj_out 2}} nl \
			  [list __cols__ 2 "Resize $dn" {form_done .obj_out 4}]\
			  {Cancel {form_done .obj_out 3}}]
	} else {
	    set buts [list \
			  {{Allow out} {form_done .obj_out 0}} \
		      {Move {form_done .obj_out 1}} \
		      {Cancel {form_done .obj_out 3}} nl \
		      [list __cols__ 2 "Resize $dn" {form_done .obj_out 4}]]
	}
	form_kill .obj_out
	set d [form_init .obj_out "Objects outside" "" $buts]
	if {$d == ""} { return 0 }

	form_label $d.m1 "The following objects are now outside\nof\
		the $type_name(domain):" {0 0} "" 1 l
	set items ""
	foreach {out issh} $outside {
	    if $issh {
		set n [$out get -name]
		if {$n == "body"} {
		    lappend items "[[$out get -object] getval name]"
		} else {
		    lappend items "[[$out get -object] getval name], $n"
		}
	    } else {
		lappend items "[$out getval name]"
	    }
	}
	form_listbox $d.tl "" $items "" "" "30x10" {1 0}
	form_label $d.m2 "Select one:\n\
	    1. Allow them to remain outside.\n\
	    2. Move them inside the $dn.\n\
	    3. Resize them so they are inside the $dn.\n\
	    4. Resize the $dn to hold the objects.\n\
	    5. Cancel the operation." {2 0} "" 1 l
	form_finish +300+300
	set what [form_wait .obj_out]

	switch $what {
	    0 { }
	    1 {
		foreach {out issh} $outside {
		    if $issh {
			catch {$out bring_inside $domsh 1} mess
			update_decorations $out
			if {$mess != ""} {
			    tk_dialog .move_stuff "" $mess "" 0 Okay
			}
			app_clean_up_[$obj getval obtype] $obj
		    } else {
			set bb [bbox_of_objects $out]
			set tmp [shape_hexa -point1 [lindex $bb 0] -point2 [lindex $bb 1]]
			catch {$tmp bring_inside $domsh 1} mess
			if {$mess != ""} {
			    tk_dialog .move_stuff "" $mess "" 0 Okay
			}
			set oldmin [lindex $bb 0]
			set newmin [$tmp getval point1]
			$tmp delete
			set off ""
			foreach i {0 1 2} {
			    lappend off [expr [lindex $newmin $i] - \
					     [lindex $oldmin $i]]
			}
			#puts "move_whole_object $obj $off"
			move_whole_object $out $off
		    }
		}
		return 2
	    }
	    2 {
		foreach {out issh} $outside {
		    if $issh {
			set obj [$out get -object]
			catch {$out bring_inside $domsh 0} mess
			update_decorations $out
			if {$mess != ""} {
			    tk_dialog .resize_stuff "Resize" $mess "" 0 Okay
			}
		    } else {
			user_error "Can't resize a [$out getval obtype]"
		    }
		}
		return 2
	    }
	    3 {
		if $undo_if_cancel undo_action
		return 1
	    }
	    4 {
		set shapes $domsh
		foreach {out issh} $outside {
		    if $issh {
			lappend shapes $out
		    } else {
			set shapes [concat $shapes [db_shapes $out]]
		    }
		}
		puts $shapes
		set bb [eval bbox_of_images $shapes]
		$domsh setval -noconstr point1 [lindex $bb 0]
		$domsh setval -noconstr point2 [lindex $bb 1]
		app_clean_up_domain $domain
		db_dirty mesh
		return 2
	    }
	}
    }
    
    return 0
}

proc edit_reset_params {{both 1}} {
    global current_shape current_object
    if {$current_object == ""} return ; # error "No current object selected"
    
    if {$current_shape != ""} {
	$current_shape to_var shape_data shape_data_units
	if {[$current_shape get -shtype] == "container"} update_container_bbvars
    }
    if $both {
	edit_object_to_var $current_object model_data model_data_units
    }
}

proc edit_reset_one_param {var} {
    global current_shape
    $current_shape to_var_one shape_data $var shape_data_units
    if {[$current_shape get -shtype] == "container"} update_container_bbvars
}

proc edit_modify_object {obj obp {shtype ""} {shp ""}} {
    global edit_current_active current_object
    
    set ogroups [$obj getval groups ""]
    eval $obj setval $obp
    set ngroups [$obj getval groups ""]
    
    if [string compare $ogroups $ngroups] {
	db_put_in_groups $obj $ogroups $ngroups
    }
    
    set t [$obj getval obtype]
    if {[info procs app_clean_up_$t] != ""} {
	app_clean_up_$t $obj
    }
    
    if {$shtype != ""} {
	[db_shapes $obj 0] configure -exp_shape $shtype
    }
    
    create_shapes $obj
    
    if {$shp != ""} {
	set sh [db_shapes $obj 0]
	eval $sh setval -noconstr $shp
	if {[$sh get -shtype] == "polygon"} {
	    # HACK - do it a second time because if one of the shape params
	    # is nverts the first time it will mess up
	    eval $sh setval -noconstr $shp
	}
    }
    
    make_visible $obj [$obj si_value active]
    
    if {$obj == $current_object} {
	set edit_current_active [$obj si_value active]
	edit_reset_params
    }
    
    db_dirty mesh
}

proc edit_modify_shape {obj name params} {
    set sh [$obj getval ${name}_shape]
    eval $sh setval -noconstr $params
}

proc edit_modify_object_units {obj units} {
    foreach {n v} $units { $obj setunits $n $v }
}

proc edit_modify_shape_units {obj name units} {
    set sh [$obj getval ${name}_shape]
    foreach {n v} $units { $sh setunits $n $v }
}

# -----------------

proc edit_multiple_objects {obtype objects} {
    global model_data model_data_units
    global model_data2 model_data_units2
    global object_params_affect_mesh current_stype
    global edit_geometry_okay edit_nameactive_okay
    global edit_multiple_objects_mess_printed
    global edit_update_button_active
    global editing_multiple_objects
    global current_genus

    set editing_multiple_objects $objects
    switch $obtype {
	part -  domain - profile {
	    user_error "Can't edit multiple $obtype objects"
	    return
	}
    }
    
    #    update_mtype $obtype
    set current_stype ""
    
    set n 0
    foreach obj $objects {
	if !$n {
	    edit_object_to_var $obj model_data model_data_units
	    incr n
	} else {
	    foreach v {model_data2 model_data_units2} { catch {unset $v} }
	    
	    edit_object_to_var $obj model_data2 model_data_units2
	    
	    foreach v [array names model_data2] {
		if [info exists model_data($v)] {
		    if {$model_data($v) != $model_data2($v)} {
			set model_data($v) ""
		    }
		} else {
		    set model_data($v) $model_data2($v)
		}
	    }
	    foreach v [array names model_data_units2] {
		if [info exists model_data_units($v)] {
		    if {$model_data_units($v) != $model_data_units2($v)} {
			set model_data_units($v) ""
			set model_data($v) ""
		    }
		} else {
		    set model_data_units($v) $model_data_units2($v)
		}
	    }
	    
	}
    }
    set model_data(name) "*multiple*"
    
    if ![info exists edit_multiple_objects_mess_printed] {
	mess "Note that fields that are blank are different in some objects.\
		If you leave them blank they will not be modified for any\
		objects.  If you set them to some value they will be changed\
		to that value for all objects.\n"
	set edit_multiple_objects_mess_printed 1
    }
    
    set edit_geometry_okay 0
    set edit_nameactive_okay 0
    set edit_update_button_active 0
    set form [edit_current_object $obtype]
    set ret [form_wait $form]
    set edit_update_button_active 1
    set edit_geometry_okay 1
    set edit_nameactive_okay 1
    
    if !$ret { return 0 }
    
    # We can't just unset these because they are attached to widgets.
    # So set them to __ignore__ which the model from_var command will skip.
    foreach d [array names model_data] {
	if {($model_data($d) == "") || ([info exists model_data_units($d)] && \
					    ($model_data_units($d) == ""))} {
	    if {$d != "obj_color"} {
		set model_data($d) __ignore__
	    }
	    if [info exists model_data_units($d)] {
		set model_data_units($d) __ignore__
	    }
	}
	if [string match *_shape $d] { set model_data($d) __ignore__ }
    }
    foreach d {
	name active groups section_list obtype fixvals creation_order 
	current_section current_stype
    } {
	set model_data($d) __ignore__
    }
    
    foreach obj $objects {
	set current_object $obj
	set current_genus $model_data(current_genus)
 	edit_set_category genus ""
	set mch [$obj from_var model_data old_object_val \
		     model_data_units]
	
	if {$mch != ""} {
	    db_dirty model
	    foreach m $mch {
		if {[info exists object_params_affect_mesh($obtype,$m)] || \
			[info exists object_params_affect_mesh($obtype,all)]} {
		    db_dirty mesh; break
		}
	    }
	}
	
	# Now toss in the undo stuff.
	set vals ""
	foreach v [array names old_object_val] {
	    lappend vals [list $v $old_object_val($v) $model_data($v)]
	}
	if {$vals != ""} {
	    undo_record_change_object $obj $vals [$obj getval name]
	}
	
	if {[info procs app_clean_up_$obtype] != ""} {
	    mess_start_saving
	    app_clean_up_$obtype $obj
	    set mess [mess_end_saving]
	    
	    set red ""
	    foreach {m c} $mess {
		if {$c == "red"} { append red $m }
	    }
	    if {$red != ""} {
		set mess "The following problems were found:\n\n$red\nCancel the change?"
		if ![tk_dialog .no_change "Problems" $mess "" -1 Yes No] {
		    undo_action
		}
	    }
	}
	
	foreach sh [db_shapes $obj] {
	    update_decorations $sh
	    shape_configure $sh
	    
	    set ret [$sh verify general]
	    if {$ret != ""} { user_error "Warning: $ret" }
	}

	if {[info commands app_verify_$obtype] != ""} {
	    set ret [app_verify_$obtype $obj]
	    if {$ret != ""} { mess "Warning: $ret\n" red }
	}
    }
    # Now reset the model_data fields from the current object
    unset editing_multiple_objects
    edit_reset_params
}

# -----------------

proc edit_set_params {type genus section shape nowin} {
    global object_edit_params shape_data
    global edit_frame current_stype

    if {[info command app_edit_set_params] != ""} {
	app_edit_set_params $edit_frame.mod.params
	grid columnconfigure $edit_frame.mod 0 -weight 0
	grid columnconfigure $edit_frame.mod 1 -weight 1000
	return
    }
    
    edit_put_shape $shape $nowin $type $genus

    edit_put_top_menus $type $genus $section $shape $nowin

    # Now put the object-specific junk in.
    
    set tw $edit_frame.mod.params.object
    set w $tw.${type}_${genus}_${section}
    
    set labw [winfo reqwidth $edit_frame.mod.params.top.sectionl]
    
    if {$type == ""} {
	if ![winfo exists $w] {
	    frame $w
	}
    } elseif {![winfo exists $w]} {
	frame $w
	
	if [info exists object_edit_params($type,$section,$shape)] {
	    set eparams $object_edit_params($type,$section,$shape)
	} elseif [info exists object_edit_params($type,$genus)] {
	    set eparams $object_edit_params($type,$genus)
	} else {
	    set eparams ""
	}
	
	set r 0
	set ne 0
	foreach parm $eparams {
	    switch [lindex $parm 0] {
		button {
		    button $w.but_$r -text [lindex $parm 1] \
			-command [lindex $parm 2]
		    grid $w.but_$r -row $r -column 0 -columnspan 2 -sticky ew
		    incr r
		}
		label {}
		line {}
		default {
		    set label [lindex $parm 0]
		    set var [lindex $parm 2]
		    set choices [lrange $parm 3 end]
		    set ll $w.lab_$r
		    set vv $w.wid_$r
		    label $ll -text $label
		    set unittype ""
		    if {[lindex $choices 0] == "has_units"} {
			set unittype [lindex $choices 1]
			set choices [lrange $choices 2 end]
		    }
		    if {[lindex $choices 0] == "active"} {
			set active [lindex $choices 1]
			set choices [lrange $choices 2 end]
			form_doactive $w.lab_$r label $active
		    } else {
			set active ""
		    }
		    
		    if {[llength $choices] > 1} {
			set ch0 [lindex $choices 0]
			set adv ""
			if [string match +* $ch0] {
			    set adv "; [string range $ch0 1 end]"
			    set choices [lrange $choices 1 end]
			}
			
			set after edit_modify_params
			set func list
			foreach ch $choices {
			    if [string match +* $ch] {
				set after [string range $ch 1 end]
			    } else {
				set chn [lindex $ch 0]; set chv [lindex $ch 1]
				if {$chv == ""} { set chv $chn }
				lappend func [list $chv $chn]
			    }
			}
			
			futil_menuentry_labels $vv $var $func \
			    "" $active "$adv ; $after"
			
		    } else {
			if {$unittype != ""} {
			    model_unitentry $vv $var $unittype "" $active
			    set ents($ne) $vv.e
			} else {
			    entry $vv -justify right -width 6 \
				-textvariable $var
			    set ents($ne) $vv
			    if {$active != ""} {
				form_doactive $w.wid_$r entry $active
			    }
			}
			bind $vv <Control-r> "edit_reset_one_param $var"
			incr ne
		    }
		    
		    grid $ll -row $r -column 0 -sticky w
		    grid $vv -row $r -column 1 -sticky ew
		    grid columnconfigure $w 0 -minsize $labw -weight 0
		    grid columnconfigure $w 1 -weight 1000
		    incr r
		}
	    }
	}
	for {set i 0} {$i < $ne} {incr i} {
	    set next $ents([expr {($i + 1) % $ne}])
	    set prev $ents([expr {($i + $ne - 1) % $ne}])
	    bind $ents($i) <Return>    "edit_modify_params"
	    bind $ents($i) <Down>      "focus $next; $next select range 0 end"
	    bind $ents($i) <Tab>       "focus $next; $next select range 0 end"
	    bind $ents($i) <Up>        "focus $prev; $prev select range 0 end"
	    bind $ents($i) <Shift-Tab> "focus $prev; $prev select range 0 end"
	}
    }
    grid columnconfigure $w 0 -weight 0
    grid columnconfigure $w 1 -weight 1000
    
    set ow [pack slaves $tw]
    if {$ow != $w} {
	if {$ow != ""} { pack unpack $ow }
	pack $w -side top -fill both -expand 1
    }

    # This is necessary to get the right fields updated.
    if {$type != ""} {
	#update  this mustn't done because we have some pending events that
	# would get fired at the wrong times.
	foreach p {plane axis} {
	    if [info exists shape_data($p)] {
		set shape_data($p) $shape_data($p)
	    }
	}
    }
    
    # Now in case the number of sections for this object has changed in a
    # dynamic way, rebuild the section nodebook.
    edit_check_sections_changed
}

proc edit_shape_list_names {} {
    global edit_shape_with_name model_container
    
    catch {unset edit_shape_with_name}
    set names ""
    foreach obj [$model_container list_contents name alpha] {
	set obn [$obj getval name]
	foreach shn [$obj getval section_list] {
	    lappend names $obn/$shn
	}
    }
    return $names
}

proc edit_shape_get_by_name {name} {
    global model_container

    set obn [file dirname $name]
    set shn [file tail $name]
    set obj [$model_container get_name $obn 1]
    return [$obj getval $shn]
}

# -----------------------------------------------

proc edit_put_top_menus {type genus section stype nogeo} {
    global object_edit_info object_edit_genus_name
    global advanced_mesher_ok shape_only_advanced
    global edit_current_options
    global edit_frame current_object current_stype

    if {($current_object != "") && [$current_object getval no_geometry_modify 0]} {
	set nogeo_mod 1; set nogeo 1
    } else {
	set nogeo_mod 0
    }
    
    set t $edit_frame.mod.params.top

    catch {unset edit_current_options}

    if {$type == ""} {
	foreach sl [grid slaves $t] { grid forget $sl }
	return
    }

    if {$type != "domain"} {
	grid $t.namel -row 1 -column 0 -sticky ew
	grid $t.name -row 1 -column 1 -sticky ew
	grid $t.groupsl -row 2 -column 0 -sticky ew
	grid $t.groups -row 2 -column 1 -sticky ew
    } else {
	foreach i {namel name groupsl groups} {
	    catch {grid forget $t.$i}
	}
    }

    set t2 $edit_frame.mod.params.buts
    grid $t2.apply -row 0 -column 0 -sticky ew -padx 2
    grid $t2.reset -row 0 -column 1 -sticky ew -padx 2
    grid $t2.edit -row 0 -column 2 -sticky ew -padx 2

    set sect_info [lrange [lindex $object_edit_info($type) 0] 2 end]
    if {$sect_info == "check_object"} {
	set sect_info [$current_object getval section_type_list]
    }

    if [info exists object_edit_genus_name($type)] {
        set genus_lab $object_edit_genus_name($type)
    } else {
        set genus_lab Type
    }
    if {[llength $object_edit_info($type)] > 1 && $genus_lab != "" && !$nogeo_mod} {
	$t.genusl configure -text $genus_lab
	grid $t.genusl -row 5 -column 0 -sticky ew
	grid $t.genus -row 5 -column 1 -sticky ew

	foreach gen $object_edit_info($type) {
	    set gt [lindex $gen 0]
	    if {$gt == $genus} {
		set sect_info [lrange $gen 2 end]
	    }
	    lappend edit_current_options(genus) [list $gt [lindex $gen 1]]
	}
    } else {
	catch {grid forget $t.genusl}
	catch {grid forget $t.genus}
    }

    if $nogeo {
	foreach i {sectionl section stypel stype} {
	    catch {grid forget $t.$i}
	}
    } else {
	set stype_info [lrange [lindex $sect_info 0] 2 end]
	if {[llength $sect_info] > 1} {
	    grid $t.sectionl -row 6 -column 0 -sticky ew
	    grid $t.section -row 6 -column 1 -sticky ew

	    foreach sect $sect_info {
		set st [lindex $sect 0]
		if {$st == $section} {
		    set stype_info [lrange $sect 2 end]
		}
		lappend edit_current_options(section) \
		    [list $st [lindex $sect 1]]
	    }
	} else {
	    catch {grid forget $t.sectionl}
	    catch {grid forget $t.section}
	}

	if {[llength $stype_info] > 1} {
	    grid $t.stypel -row 7 -column 0 -sticky ew
	    grid $t.stype -row 7 -column 1 -sticky ew

	    foreach st $stype_info {
		set state normal
		if {!$advanced_mesher_ok && \
			[info exists shape_only_advanced([lindex $st 0])]} {
		    set state disabled
		}
		lappend edit_current_options(stype) \
		    [list [lindex $st 0] [lindex $st 1]]
	    }
	} else {
	    catch {grid forget $t.stypel}
	    catch {grid forget $t.stype}
	}

	set labw [winfo reqwidth $edit_frame.mod.params.top.sectionl]
	grid columnconfigure $edit_frame.mod.params.top 0 \
	    -minsize $labw -weight 0
    }
    # This ensures that futil_update_choicemenu_text will get called and update
    # the fields as necessary...
    foreach t {genus section stype} {
	global current_$t
	set current_$t [set $t]
    }
}

proc edit_current_options {what} {
    global edit_current_options
    if [info exists edit_current_options($what)] {
	return $edit_current_options($what)
    } else {
	return ""
    }
}

proc edit_set_category {what option {put_undo 1}} {
    global current_genus current_section current_stype
    global current_object current_shape model_data
    global grid_usesize_x
    global grid_usesize_y
    global grid_usesize_z
    global grid_set_default_sizes
    
    if {$what == "stype"} {
	set oshvals ""
	foreach v [$current_shape list_values] { eval lappend oshvals $v }
    } else {
	set oshvals ""
    }
    
    set obj $current_object
    if {$obj == ""} return
    
    if {$option != ""} {
	set current_${what} $option
    }
    
    set okcmd app_can_modify_[$obj getval obtype]_$what
    if {[info command $okcmd] != ""} {
	if ![$okcmd $obj [set current_${what}]] {
	    set current_${what} [$obj getval current_${what}]
	    return
	}
    }
    
    set obtype [$obj getval obtype]
    if {($what != "section") && ([info command app_clean_up_$obtype] != "")} {
	app_clean_up_$obtype $obj
    }

    if {$what == "stype"} {
	set cur [$current_shape get -shtype]
    } else {
	set cur [$obj getval current_${what} ""]
    }
    
    set new [set current_${what}]
    if {$cur == $new} return

    if {($what == "section") && ![$current_object checkval ${new}_shape]} {
	return
    }

    $obj setval current_${what} $new
    set model_data(current_${what}) $new
    set current_${what} $new
    if {($current_shape != "") && ($what == "stype")} {
	$current_shape configure -exp_shape $current_stype
    }
    if {$what != "section"} {
	# Make sure the undo stuff doesn't happen here because it
	# happens later
	create_shapes $obj "" "" "" 0 "" 0
	if ![$obj checkval ${current_section}_shape] {
	    # We must have changed genus and create shapes blew away the old one
	    set current_section [lindex [$obj getval section_list] 0]
	    $obj setval current_section $current_section
	}
    }
    if {($what != "section") && ([info commands app_clean_up_$obtype] != "")} {
	app_clean_up_$obtype $obj
    }

    if {![string equal $model_data(name) "*multiple*"]} {
	model_set_current $obj 1
    }
    
    make_visible $obj [$obj si_value active]

    
    set nowin [expr {[$obj checkval fix_shapes] && ![string compare [$obj getval fix_shapes] 1]}]
    edit_set_params $obtype $current_genus \
	$current_section $current_stype $nowin
    
    if {$what != "section"} {
	if {[info commands app_verify_$obtype] != ""} {
	    set ret [app_verify_$obtype $obj]
	    if {$ret != ""} { mess "Warning: $ret\n" red }
	}
    }
    if $put_undo {
	undo_record_change_object_category $obj $what $cur $new $oshvals
    }
    if {$what != "section"} {
	db_dirty mesh
    }
    if {$what == "stype" && $obtype == "domain" } {
 	if {![tk_dialog .really_clear "Confirm" "The domain type has been changed. The meshing parameters from the previous domain shape will no be longer used." "" 0 Continue Cancel]} {
	    set grid_usesize_x 0
	    set grid_usesize_y 0
	    set grid_usesize_z 0
	    set grid_set_default_sizes 0
	    grid_set_default_sizes   
	}
    } 
}

proc edit_set_shape {obj sh {sect cur} {initialize 1}} {
    global current_object current_shape current_mtype current_genus
    global current_section current_stype job_diff_flag model_container
    
    if {$sect == "cur"} {
	if {$obj == $current_object} {
	    set sect $current_section
	} else {
	    set sect body
	}
    }

    edit_do_set_shape $obj $sh $sect $initialize
    
    set obtype [$obj getval obtype]
    
    if {[info commands app_clean_up_$obtype] != ""} {
	app_clean_up_$obtype $obj
    }
    
    make_visible $obj 1
    if {$obj == $current_object} {
	set current_shape $sh
	set current_stype [$sh get -shtype]
	model_set_current $obj 1
	set nowin [expr {[$obj checkval fix_shapes] && ![string compare [$obj getval fix_shapes] 1]}]
	edit_set_params $current_mtype $current_genus \
	    $current_section $current_stype $nowin
    }
    
    if {[info procs app_clean_up_$obtype] != ""} {
	app_clean_up_$obtype $obj
    }
    if {[info commands app_verify_$obtype] != ""} {
	set ret [app_verify_$obtype $obj]
	if {$ret != ""} { mess "Warning: $ret\n" red }
    }
    
    db_dirty mesh
}

proc edit_do_set_shape {obj sh sect initialize} {
    global tdv_default
    global current_object current_shape current_genus
    global current_section current_stype job_diff_flag model_container
    
    $sh init_units [unit_get_default_choice length]
    catch {$sh configure -diff_flag $job_diff_flag}
    
    $sh configure -container [$model_container getval body_shape]
    
    set obtype [$obj getval obtype]
    set shtype [$sh get -shtype]
    
    set prev [$obj getval ${sect}_shape]
    if {$prev == $sh} return
    if {$prev != ""} { $prev delete }
    
    $obj setval current_stype $shtype
    $sh configure -exp_shape "" -object $obj -name $sect
    $obj setval ${sect}_shape $sh
    set sl [$obj getval section_list]
    if {[lsearch $sl $sect] == -1} {
	lappend sl $sect
	$obj setval section_list $sl
    }
    $tdv_default add_tag $sh obtype_$obtype
    $tdv_default add_tag $sh obtype_all
    set_label_for_shape $sh
    
    $tdv_default add_image $sh
    
    shape_configure $sh
}

proc edit_buttons {form type} {
    global editing_multiple_objects is_iceboard
    
    if {$type == "domain"} {
	return [list [list Update "if \[form_check_values $form\] \{\
				form_widgets_to_variables $form; \
				edit_modify_params\}" edit_update_button_active] \
		    [list Reset  "edit_reset_params"] \
		    [list Done   "if \[form_check_values $form\] \{
				form_widgets_to_variables $form; \
				edit_modify_params; \
			        form_done $form; \
		                set form_done_flag($form) 1 \}"] \
		    [list Cancel "edit_reset_params; \
			       form_done $form; \
			       set form_done_flag($form) 0"] \
		    [list Help "help_window_path $form"]]
    } else {
	if {$type == "part"} {
	    set but1 [list "Write assembly" part_save_to_job]
	} elseif {$type == "material"} {
	    set but1 ""
	} elseif {$type == "profile"} {
	    set but1 ""
	} else {
	    set but1 [list "Copy from" edit_copyfrom]
	}
	
	set multiple_obs [info exists editing_multiple_objects]
	
	set up [list Update "if \[form_check_values $form\] \{\
				form_widgets_to_variables $form; \
				edit_modify_params \}" edit_update_button_active]
	set new [list New    "edit_modify_params; edit_new_button $type"]
	set reset [list Reset  "edit_reset_params"]
	set delete [list Delete "trash_add \$current_object"]
	set done [list Done   "if \[form_check_values $form $multiple_obs\] \{
				form_widgets_to_variables $form; \
				edit_modify_params; \
			        form_done $form; \
		                set form_done_flag($form) 1 \}"]
	set cancel [list Cancel "edit_reset_params; \
			       form_done $form; \
			       set form_done_flag($form) 0"]
	set help [list Help "help_window_path $form"]
	
	if $is_iceboard {
	    return [list $up $reset $delete nl $done $cancel $help]
	} else {
	    return [list $up $new $reset $delete nl $but1 $done $cancel $help]
	}
    }
}

proc edit_sub_buttons {form} {
    return [list [list Update "edit_modify_params"] \
		[list Reset  "edit_reset_params"] \
		[list Done   "edit_modify_params; \
			       form_done $form; \
		               set form_done_flag($form) 1"] \
		[list Cancel "edit_reset_params; \
			       form_done $form; \
			       set form_done_flag($form) 0"] \
		[list Help "help_window_path $form"]]
}

# ** should use this above

proc edit_done {type} {
    global form_done_flag
    
    set form .edit_params_$type
    edit_modify_params
    form_done $form
    set form_done_flag($form) 1
}

proc edit_form_is_up {} {
    foreach ch [winfo children .] {
	if {[string match .edit_params_* $ch] && [winfo viewable $ch]} {
	    return 1
	}
    }
    return 0
}

proc edit_current_object {{group_obtype ""}} {
    global botform_geo object_type_title object_uses_material
    global object_edit_info current_object edit_no_units type_name
    global object_edit_separate_shapedata object_edit_use_notebook
    global object_notebook_pages no_fix_value_on_property_form 
    global creating_object_form editing_material_definition model_data
    global edit_object_only_info_notes is_iceboard
    
    if {($group_obtype == "") && ($current_object == "")} {
	user_error "Please select an object before clicking on the Edit button."
	return
    }
    set in_edit_current_object 1

    if [info exists creating_object_form] {
	bell
	return
    }
    set creating_object_form 1
    busy 1
    set err [catch {
	if {$group_obtype != ""} {
	    set no_geometry_modify 0
	    set type $group_obtype
	} else {
	    set type [$current_object getval obtype]
	    set no_geometry_modify [$current_object getval no_geometry_modify 0]
	}

	set form .edit_params_$type

	if $no_geometry_modify { append form _nogeom }

	if {![info exists object_edit_separate_shapedata($type)] &&
	    [info exists object_edit_info($type)] &&
	    [llength $object_edit_info($type)] &&
	    ($type != "part") && ($type != "material") && ($type != "profile") &&
	    ![info exists object_notebook_pages($type)]} {
	    set need_geom 1
	} else {
	    set need_geom 0
	}

	set w [form_init $form $object_type_title($type) \
		   model [edit_buttons $form $type] edit_modify_params]
	if {$w != ""} {
	    if {[info exists edit_object_only_info_notes(all)] && ($type != "material")} {
		set pageinfo ""
		set pages [form_notebook $w.nb {
		    { info Info }
		    { notes Notes }
		} {0 0}]
		set winfo   [lindex $pages 0]
		set wnotes  [lindex $pages 1]
		set need_geom 0
		
	    } elseif $need_geom {
		set pageinfo [list shape Geometry object Properties]
		set pages [form_notebook $w.nb {
		    { info Info }
		    { shape Geometry }
		    { object Properties }
		    { notes Notes }
		} {0 0}]
		set winfo   [lindex $pages 0]
		set wshape  [lindex $pages 1]
		set wobject [lindex $pages 2]
		set wnotes  [lindex $pages 3]

	    } else {
		if [info exists object_notebook_pages($type)] {
		    set pageinfo $object_notebook_pages($type)
		    set list_pages {{info Info}}
		    foreach {n t} $pageinfo { lappend list_pages [list $n $t] }
		    lappend list_pages {notes Notes}
		    set pages [form_notebook $w.nb $list_pages {0 0}]

		} else {
		    set pageinfo { object Properties }

		    set pages [form_notebook $w.nb {
			{ info Info }
			{ object Properties }
			{ notes Notes }
		    } {0 0}]

		}
		set winfo [lindex $pages 0]
		set i 0
		foreach {p n} $pageinfo {
		    set w$p [lindex $pages [incr i]]
		}
		incr i
		set wnotes [lindex $pages $i]
	    }

	    form_label $winfo.namel "Name" {1 0} edit_nameactive_okay
	    form_entry $winfo.name model_data(name) string {1 1 -cols 1} \
		edit_nameactive_okay 20

	    switch $type {
		profile {
		    if [info exists use_profile_display_properties] {
			form_label $winfo.coll "Color" {1 3}
			form_label $winfo.shll "Shading" {2 0}
			form_label $winfo.linl "Linewidth" {2 3}
			futil_colorentry $winfo.col model_data(obj_color) {1 4}
			futil_menuentry $winfo.shl model_data(obj_shading) \
			    {list View Wire Solid Solid/wire {Hidden line} Invisible} {2 1}
			futil_menuentry $winfo.lin model_data(obj_linewidth) \
			    {list 1 2 3 4 5} {2 4}
		    }
		}
		material {
		    if [info exists use_material_display_properties] {
			
			set texact {{model_data(obj_shading) Solid Solid/wire}}
			set texscact [concat $texact {{model_data(obj_texture) !}}] ;# the single ! means "not blank"
			form_label $winfo.coll "Color" {1 3}
			form_label $winfo.shll "Shading" {2 0}
			form_label $winfo.linl "Linewidth" {2 3}
			form_label $winfo.texl "Texture" {3 0} $texact
			form_label $winfo.texsl "Texture scale" {4 0} $texscact
			form_checkbutton $winfo.transl "Transparency\n(0 = opaque)" model_data(obj_transparency_on) {5 0}
			futil_colorentry $winfo.col model_data(obj_color) {1 4}
			futil_menuentry $winfo.shl model_data(obj_shading) \
			    {list View Wire Solid Solid/wire {Hidden line} Invisible} {2 1}
			futil_menuentry $winfo.lin model_data(obj_linewidth) \
			    {list 1 2 3 4 5} {2 4}
			futil_listentry $winfo.tex model_data(obj_texture) \
			    "texture_list" {3 1} $texact \
			    "texture_select model_data(obj_texture)" 1
			form_entry $winfo.texsc model_data(obj_texture_scale) \
			    float {4 1} $texscact
			form_scale $winfo.trans model_data(obj_transparency) "update_current_transparency model_data(obj_transparency)" h 0.0 .99 0.01 {5 1} model_data(obj_transparency_on) "" 100
		    }
		    #form_checkbutton $winfo.cust "Custom" model_data(mat_custom) {1 4}
		}
		domain {
		    if {$winfo != ""} {
			set disp_options [form_label_frame  $winfo.opnx "Display options" {2 0 -cols 2}]
		    }
		    form_label $disp_options.linl "Linewidth" {3 0}
		    form_label $disp_options.coll "Color" {4 0}
		    futil_menuentry $disp_options.lin model_data(obj_linewidth) \
			{list default 1 2 3 4 5} {3 1}
		    futil_colorentry $disp_options.col model_data(obj_color) \
			{4 1 -rows 2} "" "default" \
			model_data(obj_color_default)
		}
		default {
		    form_label $winfo.entl "Groups" {2 0} edit_nameactive_okay
		    futil_listentry $winfo.ent model_data(groups) "coll_list group" {2 1} edit_nameactive_okay "" 1

		    form_label $winfo.pril "Priority" {3 0}
		    form_entry $winfo.pri model_data(creation_order) int_blank {3 1}

		    form_checkbutton $winfo.active Active model_data(active) \
			{1 3} edit_nameactive_okay
		    #form_checkbutton $winfo.vis Visible model_data(obj_visible) {3 1}
		    $winfo.active configure -command {
			set edit_current_active $model_data(active)
			edit_toggle_current_active
		    }
		    #$winfo.vis configure -command {reconfigure_object $current_object}
		    if {$winfo != ""} {
			set disp_options [form_label_frame  $winfo.opnx "Display options" {4 0 -cols 2}]
		    }
		    
		    set texact {{model_data(obj_shading) Solid Solid/wire}}
		    set texscact [concat $texact {{model_data(obj_texture) !}}]	
		    form_label $disp_options.shll "Shading" {4 0}
		    form_label $disp_options.linl "Linewidth" {5 0}
		    form_label $disp_options.coll "Color" {6 0}
		    form_label $disp_options.texl "Texture" {8 0} $texact
		    form_label $disp_options.texsl "Texture scale" {9 0} $texscact
		    form_checkbutton $disp_options.transl "Transparency\n(0 = opaque)" model_data(obj_transparency_on) {10 0}
		    futil_menuentry $disp_options.shl model_data(obj_shading) \
			{list default Wire Solid Solid/wire {Hidden line} \
			     Invisible} {4 1}
		    futil_menuentry $disp_options.lin model_data(obj_linewidth) \
			{list default 1 2 3 4 5} {5 1}
		    futil_colorentry $disp_options.col model_data(obj_color) \
			{6 1 -rows 2} "" "default" \
			model_data(obj_color_default)
		    $winfo.ent configure -width 7

		    futil_listentry $disp_options.tex model_data(obj_texture) \
			"texture_list" {8 1} $texact \
			"texture_select model_data(obj_texture)" 1
		    form_entry $disp_options.texs model_data(obj_texture_scale) float {9 1} $texscact
		    form_scale $disp_options.trans model_data(obj_transparency) "update_current_transparency model_data(obj_transparency)" h 0.0 .99 0.01 {10 1} model_data(obj_transparency_on) "" 100
		    #??
		    #form_button $winfo.fromcad "From CAD" cad_to_shape {4 0}
		}
	    }
	    set amf [info commands app_make_form_${type}_info]
	    if {$amf != ""} {
		$amf $winfo 10
	    }

	    grid columnconfigure $winfo 10 -weight 1000

	    if $need_geom {
		set amf [info commands app_edit_model_form_$type]
		if {$amf != ""} {
		    $amf $wshape
		} else {
		    if $no_geometry_modify {
			form_label $wshape.nogeom "\nTo modify the geometry for this\nobject, please modify the overall\n$type_name(domain) dimensions." {0 0}
			$wshape.nogeom configure -fg red -justify l
		    } else {
			# Create the subform for this shape type (variables are shape_data(xxx))
			edit_model_form $wshape $type
		    }
		}
	    }
	    
	    foreach {p n} $pageinfo {
		if {$p == "object"} {
		    if {[info proc app_make_form_$type] != ""} {
			app_make_form_$type $wobject
		    }
		} else {
		    if {[info proc app_make_form_${type}_$p] != ""} {
			app_make_form_${type}_$p [set w$p]
		    }
		}
	    }
	    
	    foreach page $pages {
		if {[string match *notes $page] ||
		    [string match *info $page] ||
		    ([string match *object $page] &&
		     [info exists no_fix_value_on_property_form]) ||
		    ([string match *shape $page] &&
		     $no_geometry_modify) ||
		    [winfo exists $page.fixvals]} continue
		
		form_checkbutton $page.fixvals "Fix values" \
		    model_data(fixvals) {1000 0 -cols -} {{job_all_fixvals per}}
		$page.fixvals configure -command edit_modify_params
	    }
	    
	    form_text $wnotes.text "Notes for this object" model_data(notes) \
		{0 0 -sticky news} "" 10x10
	    grid rowconfigure $wnotes 0 -weight 1000
	    grid columnconfigure $wnotes 0 -weight 1000
	    
	    form_notebook_finish $w.nb
	    
	    form_finish $botform_geo
	}
	if {[info proc app_after_form_post_$type] != ""} {
	    app_after_form_post_$type
	}
	if !$is_iceboard {
	    if {$current_object != ""} {
		switch [$current_object getval current_stype] {
		    polygon { edit_poly_changes }
		    pipe { edit_pipe_changes }
		}
	    }
	}
	
	# This is because individual sides forms can get broken
	form_cancel_class "model sub_ch" 
    } res]
    
    if {$current_object != ""} {
	set mp [$current_object getval mat_lib_path ""]
	if {![info exists editing_material_definition] &&
	    ($mp != "") && [lindex [library_name_and_info $mp] 2]} {
	    mess "Editing a library material - values can't be modified.\n" red
	}
    }
    unset creating_object_form
    busy 0
    
    if $err { 
	global errorInfo
	puts $errorInfo
	error $res
    }
    
    return $form
}

proc update_current_transparency {var args} {
    global current_object
    upvar \#0 $var lvar
    foreach sh [db_shapes $current_object] {
	$sh configure -alpha [expr 1.0 - $lvar]
    }
}

# This is used when the shape parameters are on a subform and not the main one.

proc edit_current_shapedata {} {
    global botform_geo object_type_title object_uses_material 
    global object_edit_info current_object edit_no_units
    global object_edit_separate_shapedata edit_current_shapedata_warning
    
    if ![info exists edit_current_shapedata_warning] {
	mess "Warning: if you edit the shape details of this object, and then\
		turn \"Fix shapes\" off, your detailed editing changes\
		will be lost.\n"
	set edit_current_shapedata_warning 1
    }
    
    if {$current_object == ""} {
	user_error "Please select an object before clicking on the Edit button."
	return
    }
    
    set type [$current_object getval obtype]
    
    set form .edit_shapeparams_$type
    
    set w [form_init $form "$object_type_title($type) shape data" \
	       "model shape" [edit_sub_buttons $form] edit_modify_params]
    if {$w != ""} {
	set amf [info commands app_edit_model_form_$type]
	if {$amf != ""} {
	    $amf $w
	} else {
	    edit_model_form $w $type
	}
    }
    form_finish bot
}

proc edit_model_form {d type {only_genus ""}} {
    global object_edit_info current_genus
    global advanced_mesher_ok shape_only_advanced object_edit_ignore_section
    global want_per_object_origins want_local_coord_systems current_object
    global current_section
    
    set forms ""
    
    set info $object_edit_info($type)
    if {$only_genus != ""} {
	foreach inf $info {
	    if {[lindex $inf 0] == $only_genus} {
		set info [list $inf]
		break
	    }
	}
    }
    if {[llength $info] > 1} {
	form_frame $d.glist flat 0 {0 0 -sticky nw}
	form_label $d.glist.name "Type:" {0 0}
	set c 1
	foreach genus $info {
	    set g [lindex $genus 0]
	    form_radiobutton $d.glist.$g [lindex $genus 1] current_genus \
		$g "0 [incr c]"
	    $d.glist.$g configure -command "edit_set_category genus {}"
	}
    }
    form_frame $d.g flat 0 {1 0}
    foreach genus $info {
	set gname [lindex $genus 0]
	set gtitle [lindex $genus 1]
	set sections ""
	foreach sinf [lrange $genus 2 end] {
	    set sname [lindex $sinf 0]
	    if ![info exists object_edit_ignore_section($type,$sname)] {
		lappend sections $sinf
	    }
	}
	
	form_frame $d.g.$gname flat 0 {0 0}
	
	if {[lindex [lindex $sections 0] 0] == "check_object"} {
	    set sections [$current_object getval section_type_list]
	}
	
	if {[llength $sections] > 1} {
	    set nb $d.g.$gname.s
	    form_notebook $nb "" {0 0 -sticky nw}
	    set create_me 1 ;# just create one of them to start with
	    foreach sect $sections {
		edit_model_form_shapetype $nb "" $type [lindex $sect 0] \
		    [lindex $sect 1] [lrange $sect 2 end] $create_me
		set create_me 0
		lappend forms $nb
	    }
	    set curs $current_section ;# notebook raise changes the value
	    form_notebook_finish $nb
	    trace variable current_section w "edit_model_form_raise $nb; list"
	    set current_section $curs
	    
	} else {
	    set sect [lindex $sections 0]
	    edit_model_form_shapetype "" $d.g.$gname $type [lindex $sect 0] \
		[lindex $sect 1] [lrange $sect 2 end] 1
	    lappend forms $d.g.$gname
	}
    }
    if {[llength $info] > 1} {
	futil_setup_switch $d.g current_genus
    }
    return $forms
}

proc edit_model_form_raise {nb} {
    global current_section
    if ![winfo exists $nb] return
    set cur [$nb raise]
    if {$cur != $current_section} {
	catch {$nb raise $current_section}
    }
}

# This gets called for each new section pane in an edit form.  But don't
# actually create the windows until they are displayed, unless specifically
# requested ....

proc edit_model_form_shapetype {notebook d type sname stitle shapes create} {
    global model_form_notebook_page
    
    if {$d == ""} {
	set d [form_notebook_addpage $notebook $sname $stitle \
		   edit_geometry_okay "edit_set_category section $sname"]
	if {$d == ""} return
	if !$create {
	    $notebook itemconfigure $sname -createcmd \
		[list edit_model_form_shapetype_create $d $type $shapes]
	} else {
	    edit_model_form_shapetype_create $d $type $shapes
	}
    } else {
	edit_model_form_shapetype_create $d $type $shapes
    }
        
    if 0 {    
    if $create {
	edit_model_form_shapetype_create $d $type $shapes
    } else {
	bind $d <Expose> [list edit_model_form_shapetype_create $d $type $shapes]
    }
    }
}

proc edit_model_form_shapetype_create {d type shapes} {
    global object_edit_info current_genus
    global advanced_mesher_ok shape_only_advanced object_edit_ignore_section
    global want_per_object_origins want_local_coord_systems current_object
    
#    bind $d <Expose> ""
    
    busy 1
    
    # Start at row 10 just in case something else was already put in here
    if {[llength $shapes] > 1} {
	form_label $d.geoname "Shape:" {10 0} edit_geometry_okay
	
	set func list
	foreach shape $shapes {
	    lappend func [lrange $shape 0 1]
	}
	set func "edit_current_options stype"
	futil_menuentry_labels $d.geolist current_stype $func \
	    {10 1} edit_geometry_okay "edit_set_category stype {}"
    }
    
    if [info exists want_per_object_origins] {
	form_frame $d.offsets ridge 2 "11 0 -cols 2"
	form_label $d.offsets.l "Origin:" {0 0}
	form_label $d.offsets.xl X {0 1}
	form_label $d.offsets.yl Y {0 3}
	form_label $d.offsets.zl Z {0 5}
	model_unitentry $d.offsets.x shape_data(xoff) length \
	    {0 2} "" 5
	model_unitentry $d.offsets.y shape_data(yoff) length \
	    {0 4} "" 5
	model_unitentry $d.offsets.z shape_data(zoff) length \
	    {0 6} "" 5
    } elseif [info exists want_local_coord_systems] {
	form_label $d.offsetsl "Local coord system:" {11 0}
	futil_listentry $d.offsetsn shape_data(coord_system) \
	    "model_local_coords_list" {11 1} "" \
	    "model_local_coords_set shape_data $d.offsetsn"
    }
    
    form_rowheight $d 12 10
    
    grid columnconfigure $d 9 -weight 1000
    
    form_frame $d.sh flat 0 "20 0 -cols 10 -sticky nw"
    
    foreach shape $shapes {
	set shname [lindex $shape 0]
	set shtitle [lindex $shape 1]
	
	set shw $d.sh.$shname
	form_frame $shw flat 0 {0 0 -sticky nw}
	edit_${shname}_form $shw $type shape_data 1
    }
    if {[llength $shapes] > 1} {
	futil_setup_switch $d.sh current_stype
    }
    
    busy 0
}

proc edit_check_sections_changed {} {
    global current_object current_genus object_edit_info
    
    if {$current_object == ""} return
    
    set type [$current_object getval obtype]
    foreach info $object_edit_info($type) {
	if {[lindex $info 0] != $current_genus} continue
	if {[lindex [lindex $info 2] 0] != "check_object"} continue
	set sections [$current_object getval section_type_list]
	set wantp ""
	foreach sect $sections {
	    lappend wantp [lindex $sect 0] [lindex $sect 1]
	}
	set nb .edit_params_$type.main.nb.fshape.g.default.s
	if ![winfo exists $nb] continue
	set have ""
	set pages [$nb pages]
	foreach page $pages {
	    lappend have $page [$nb itemcget $page -text]
	}
	if {$have != $wantp} {
	    foreach p $pages { form_notebook_deletepage $nb $p }
	    foreach sect $sections {
		edit_model_form_shapetype $nb "" $type [lindex $sect 0] \
		    [lindex $sect 1] [lrange $sect 2 end] 0
	    }
	    form_notebook_finish $nb
	}
    }
}

# ---------

# This function installs the appropriate shape edit form.  There are
# actually two types of edit forms: the ones in the .e form and the ones
# in the full form.

proc edit_put_shape {shape nowin obtype genus} {
    global edit_entry_advance_data toplevel
    global edit_frame edit_poly_form_path edit_pipe_form_path

    set parent $edit_frame.mod.params.shape
    set ow [grid slaves $parent]
    if {$shape == ""} {
	if {$ow != ""} { grid forget $ow }
	return
    }
    set ents ""
    if $nowin {
	set cmd [info commands app_make_edit_window_$obtype]
	set genus_cmd [info commands app_make_edit_window_${obtype}_${genus}]
	if {$cmd == "" && $genus_cmd == ""} return
	if {$genus_cmd != "" } {
	    set form $parent.${obtype}_${genus}
	    set cmd $genus_cmd
	} else {
	    set form $parent.$obtype
	}
	if ![winfo exists $form] {
	    frame $form
	    set ents [$cmd $form]
	}
    } else {
        set form $parent.$shape
	if {$shape == "polygon"} {
	    set form $parent.$shape$obtype
	}
	if ![winfo exists $form] {
	    frame $form
	    set proc1 [info command edit_${shape}_win]
	    set proc2 [info command edit_${shape}_win_bot]
	    if {$toplevel(single) && ($proc2 != "")} {
		set ents [$proc2 $form]
	    } else {
		set ents [$proc1 $form]
	    }
	}
    }
    if {$ents != ""} {
	set edit_entry_advance_data($form) $ents
	set i 0
	foreach e $ents {
	    $e configure -width 6 -justify r

	    bind $e <Return>    "edit_modify_params"
	    bind $e <Down>      "edit_entry_advance $form $i 1"
	    bind $e <Tab>       "edit_entry_advance $form $i 1; break"
	    bind $e <Up>        "edit_entry_advance $form $i -1"
	    bind $e <Shift-Tab> "edit_entry_advance $form $i -1; break"
	    incr i
	}
	grid columnconfigure $form 0 -weight 0
	grid columnconfigure $form 1 -weight 1
    }
    if {$ow != $form} {
	if {$ow != ""} { grid forget $ow }
	grid $form -sticky ew
    }

    if $nowin {
	set cmd [info commands app_update_edit_window_$obtype]
	if {$cmd != ""} {$cmd $form}
        return
    }

    switch $shape {
	polygon {
	    edit_poly_win_populate $form shape_data
	    edit_poly_win_select $form shape_data "vert 1"

	    # This is a real pain.
	    if [info exists edit_poly_form_path] {
		foreach w $edit_poly_form_path {
		    edit_poly_win_populate $w shape_data
		}
	    }
	}
	pipe {
	    edit_pipe_win_populate $form
	    edit_pipe_win_select $form "vert 1"

	    # This is a real pain.
	    if [info exists edit_pipe_form_path] {
		foreach w $edit_pipe_form_path {
		    edit_pipe_win_populate $w
		}
	    }
	}
	cyl {
	    edit_repack_cyl_win $form
	}
	cad {
	    edit_repack_cad_win $form
	}
    }
}

proc edit_entry_advance {form num dir} {
    global edit_entry_advance_data
    set ne [llength $edit_entry_advance_data($form)]
    while 1 {
	set num [expr {($num + $ne + $dir) % $ne}]
	set ent [lindex $edit_entry_advance_data($form) $num]

	if {([$ent cget -state] == "normal") && [winfo viewable $ent]} break
    }
    $ent select range 0 end
    focus $ent
}

proc edit_win_label {w text var dir basevar} {
    if {$dir == -1} {
	label $w -text $text
    } else {
	button $w -borderwidth 0 -relief flat -background #ffc090 \
	    -activebackground #ffa070
	edit_win_label_configure $w $text $var $dir $basevar
    }
}

proc edit_win_label_configure {w text var dir basevar} {
    $w configure -text $text
    if {[winfo class $w] == "Button"} {
	$w configure -command [list edit_win_align $var $dir $basevar]
    }
}

proc edit_win_align {var dir basevar {dirname ""} {offsetval ""} {offsetsign ""}} {
    global $basevar ${basevar}_units current_mtype tdv_default
    global current_shape current_object
    
    if {$dirname == ""} { set dirname [lindex {X Y Z} $dir] }
    banner "Select the point on the screen to align $dirname to with the left button."    
    tdv_cur current pick
    set pt [get_graphics_loc]
    tdv_cur current dynamics
    banner ""

    if {($current_shape == "") && ($var != "")} {
	set current_shape [$current_object getval current_shape]
	set current_section [$current_object getval current_section]
    }
       
    if {$pt != ""} {
	if {$current_shape == ""} {
	    set realpt $pt
	} else {
	    set realpt [$current_shape transform_coords_inverse $pt]
	}
	set vv [lindex $realpt $dir]
	
	set im1 [tdv_point_im -color white -size 3 -point $pt]
	set im2 [tdv_text_im -color white -point $pt \
		     -text " $dirname = $vv m"]
	$tdv_default add_image $im1
	$tdv_default add_image $im2
	update idle
	$im1 delete; $im2 delete
	
	if {$offsetval != ""} {
	    set oldvv [unit_convert [set ${basevar}($var)] [set ${basevar}_units($var)] 0]
	    set vv [expr ($vv - $offsetval) * $offsetsign + $oldvv]
	}
	
	if {$var == ""} {
	    if [info exists ${basevar}_units] {
		set $basevar [unit_convert $vv [set ${basevar}_units] 1]
	    } else {
		set $basevar $vv
	    }
	} else {
	    if [info exists ${basevar}_units($var)] {
		set ${basevar}($var) [unit_convert $vv \
					  [set ${basevar}_units($var)] 1]
	    } else {
		set ${basevar}($var) $vv
	    }
	    edit_modify_params
	}
    }
}

proc edit_select_point {w vars basevar label} {
    button $w -text $label -command [list edit_win_align_point $vars $basevar]
}

proc edit_win_align_point {vars basevar} {
    global tdv_default view_panes current_shape current_object
    global $basevar ${basevar}_units
    
    banner "Select the point on the screen to align to with the left button."
    
    tdv_cur $view_panes(all_viewers) pick
    set pt [get_graphics_loc]
    tdv_cur $view_panes(all_viewers) dynamics
    banner ""

    if {$pt == ""} return
    
    set im1 [tdv_point_im -color white -size 3 -point $pt]
    $tdv_default add_image $im1
    update idle
    after 100
    $im1 delete
    
    set pt [$current_shape transform_coords_inverse $pt]
    foreach vn $vars dir {0 1 2} {
	set vv [lindex $pt $dir]
	if [info exists ${basevar}_units($vn)] {
	    set ${basevar}($vn) [unit_convert $vv \
				     [set ${basevar}_units($vn)] 1]
	} else {
	    set ${basevar}($vn) $vv
	}
	if 0 {
	    set cmd [info commands app_after_snap_[$current_object getval obtype]]
	    if {$cmd != ""} {
		$cmd $basevar $vn
	    }
	}
    }
    edit_modify_params
}

proc edit_get_component {mess dir var uvar} {
    global tdv_default view_panes
    
    upvar $var lvar $uvar luvar
    set dirname [lindex {X Y Z} $dir]
    banner "Select the $mess with the left button."
    tdv_cur $view_panes(all_viewers) pick
    set pt [get_graphics_loc]
    tdv_cur $view_panes(all_viewers) dynamics
    banner ""
    if {$pt == ""} return
    set lvar [unit_convert [lindex $pt $dir] $luvar 1]
}

proc get_3pts {} {
    global tdv_default view_panes
    
    tdv_cur $view_panes(all_viewers) pick
    set ims ""
    set ok 1
    foreach i {1 2 3} {
	set pt$i [auto_get_location "" "" 0 "point $i"]
	set pt [set pt$i]
	if {$pt == ""} { set ok 0; break }
	
	set im [tdv_point_im -color white -size 3 -point $pt]
	$tdv_default add_image $im; lappend ims $im
	set im [tdv_text_im -color white -text " $pt" -point $pt]
	$tdv_default add_image $im; lappend ims $im
	update
    }
    foreach im $ims { $im delete }
    if $ok {
	return [list $pt1 $pt2 $pt3]
    } else {
	return ""
    }
}

proc edit_circ_from_3pts {} {
    global shape_data current_object circ_can_have_iradius shape_data_units
    global current_shape
    
    set pts [get_3pts]
    if {$pts == ""} return
    
    set pts2 ""
    foreach p $pts {
	lappend pts2 [$current_shape transform_coords_inverse $p]
    }
    
    set stuff [eval circ_from_3pts $pts2]

    # plane has to be first because it causes a rotate operation and that 
    # overwrites the other settings
    foreach {i v} { 4 plane 0 xc 1 yc 2 zc 3 radius } {
	if [info exists shape_data_units($v)] {
	    set shape_data($v) [unit_convert [lindex $stuff $i] \
				    $shape_data_units($v) 1]
	} else {
	    set shape_data($v) [lindex $stuff $i]
	}
    }
    edit_modify_params
    
    if [info exists circ_can_have_iradius([$current_object getval obtype])] {
	set pti [auto_get_location "" "" 0 "an optional inner radius point"]
	if {$pti == ""} { return }
	
	set pti [$current_shape transform_coords_inverse $pti]
	
	set dd 0
	foreach {i x} {0 x 1 y 2 z} {
	    set v [lindex $stuff $i]
	    set d [expr $v - [lindex $pti $i]]
	    set dd [expr $dd + $d * $d]
	}
	set shape_data(iradius) [unit_convert [expr sqrt($dd)] \
				     $shape_data_units(iradius) 1]
	edit_modify_params
    }
}

# ----------------------------------

proc edit_shapes_possible {obj genus section} {
    global object_edit_info
    
    foreach tt $object_edit_info([$obj getval obtype]) {
	if {[lindex $tt 0] == $genus} {
	    foreach ss [lrange $tt 2 end] {
		if {[lindex $ss 0] == $section} {
		    set ret ""
		    foreach qq [lrange $ss 2 end] {
			lappend ret [lindex $qq 0]
		    }
		    return $ret
		}
	    }
	}
    }
    return none
    # error "no shapes possible for $obj $genus $section"
}

proc edit_objects_with_shape {sht} {
    set ret ""
    foreach obj [db_list_all] {
	set shl [$obj getval section_list]
	if {[llength $shl] > 1} continue
	if ![llength $shl] {
	    if {$sht == "none"} { lappend ret $obj }
	} else {
	    set sh [$obj getval [lindex $shl 0]_shape]
	    if {[$sh get -shtype] == $sht} { lappend ret $obj }
	}
    }
    return $ret
}

proc edit_copyfrom {} {
    global current_object model_container model_data
    global current_genus current_section copy_from shape_data
    global model_data_units shape_data_units current_shape
    global no_fix_shape_data object_could_get_shape_from
    
    if {$current_object == ""} {
	user_error "Please select an object before doing \"Copy from\"."
	return
    }
    set obtype [$current_object getval obtype]
    set shposs [edit_shapes_possible $current_object $current_genus \
		    $current_section]
    set choices ""
    foreach shp $shposs {
	foreach obj [edit_objects_with_shape $shp] {
	    if {$obj == $current_object} continue
	    lappend choices [list [$obj getval name]]
	}
    }
    if [info exists object_could_get_shape_from($obtype)] {
	foreach {type shtype totype} $object_could_get_shape_from($obtype) {
	    foreach obj [edit_objects_with_shape $shtype] {
		if {[$obj getval obtype] == $type} {
		    lappend choices [list [$obj getval name]]
		    set wierd_shape([$obj getval name]) $totype
		}
	    }
	}
    }
    
    set r [check_box_form .copy_from "Copy from object" $choices \
	       10 copy_from(object) 0 "" "" {
		   form_radiobutton $d.deact "Deactivate other object" \
		       copy_from(how) deact {10 0}
		   form_radiobutton $d.del "Delete other object" \
		       copy_from(how) delete {11 0}
		   form_radiobutton $d.none "Neither" \
		       copy_from(how) none {12 0}
		   form_checkbutton $d.shi "Copy shape info" \
		       copy_from(shapeinfo) {13 0}
		   form_checkbutton $d.obi "Copy object info" \
		       copy_from(objinfo) {14 0}
		   form_checkbutton $d.cr "Copy creation order" \
		       copy_from(creation_order) {15 0}
		   form_checkbutton $d.gr "Copy groups" \
		       copy_from(groups) {16 0}
	       } "" "Object selection"]
    if {!$r || ($copy_from(object) == "")} return
    
    set obj [db_get_name $copy_from(object)]
    if {$obj == ""} {
	user_error "No such object with name \"$copy_from(object)\" was found."
	return
    }
    
    if $copy_from(shapeinfo) {
	if {$shposs != "none"} {
	    set sh [$obj getval [lindex [$obj getval section_list] 0]_shape]
	    if [info exists wierd_shape($copy_from(object))] {
		edit_set_category stype $wierd_shape($copy_from(object))
		edit_modify_params
		$current_shape initialize_shape $sh NULL 0 0
		# Just in case these shapes are in different parts ...
		set off ""
		foreach i {0 1 2} {
		    lappend off [expr [lindex [$sh get_centroid] $i] - \
				 [lindex [$current_shape get_centroid] $i]]
		}
		$current_shape translate $off
		set cmd [info commands app_make_object_fit_shape_$obtype]
		if {$cmd != ""} { $cmd $current_object $current_shape }
		app_clean_up_$obtype $current_object
		edit_reset_params
		
	    } else {
		edit_set_category stype [$sh get -shtype]
		
		# This is a really really bad hack
		set no_fix_shape_data 1
		$sh to_var shape_data shape_data_units
		unset no_fix_shape_data
		
		# Just in case these shapes are in different parts ...
		set off ""
		foreach i {0 1 2} {
		    lappend off [expr [lindex [$sh get_centroid] $i] - \
				     [lindex [$current_shape get_centroid] $i]]
		}
		
		$current_shape translate $off
		
		if {[info exists shape_data(nverts)]} {
		    # from_var doesn't update all the vertex coords if you copy from a polygon that has more vertices than the original, so do this here
		    $current_shape setval nverts $shape_data(nverts)
		}
		$current_shape from_var shape_data prev_vals shape_data_units
		
		$current_shape to_var shape_data shape_data_units
		
		set pvals ""
		foreach i [array names prev_vals] {
		    set ov $prev_vals($i)
		    set nv $shape_data($i)
		    if [info exists shape_data_units($i)] {
			set ov [unit_convert $ov $shape_data_units($i) 0]
			set nv [unit_convert $nv $shape_data_units($i) 0]
		    }
		    lappend pvals [list $i $ov $nv]
		}
		undo_record_change_shape $current_shape $pvals
		
		# hack
		if {($obtype != "fan") && [info exists shape_data(iradius)]} {
		    set shape_data(iradius) 0
		}

	    }
	}
    }
    if $copy_from(objinfo) {
	if {[$obj getval obtype] == [$current_object getval obtype]} {
	    foreach p [$obj list_values_with_units] {
		switch -glob [lindex $p 0] {
		    creation_order - groups - name continue
		    *_shape continue
		}
		if {[$obj si_value [lindex $p 0]] == "ambient"} {
		    set model_data([lindex $p 0]) ambient
		} else {
		    set model_data([lindex $p 0]) [lindex $p 1]
		}
		if {[lindex $p 2] != ""} {
		    set model_data_units([lindex $p 0]) [lindex $p 2]
		}
	    }
	} else {
	    mess "Warning: can't copy object parameters because the type\
		of \"[$obj getval name]\" is different\n" red
	}
    }
    
    if $copy_from(creation_order) {
	set model_data(creation_order) [$obj getval creation_order]
    }
    if $copy_from(groups) {
	set model_data(groups) [$obj getval groups]
    }
    edit_modify_params
    
    foreach v {plane axis} {
	if [info exists shape_data($v)] { set shape_data($v) $shape_data($v) }
    }
    
    switch $copy_from(how) {
	deact {
	    if {[$obj getval obtype] != "domain"} {
		edit_toggle_current_active $obj 1
	    }
	}
	delete {
	    trash_add $obj
	}
    }
}

proc edit_clean_up_all {} {
    global app_has_clean_up
    
    busy 1
    foreach obj [db_list_objects_recursive] {
	set t [$obj getval obtype]
	if [info exists app_has_clean_up($t)] {
	    app_clean_up_$t $obj
	}
    }
    busy 0
}

proc edit_create_button {type drag {but ""}} {
    global tdv_default selected_shape current_object drag_creating_object
    
    if [info exists drag_creating_object] return
    if $drag { set drag_creating_object 1 }
    
    edit_new $type "" 1 "" "" "" "" [expr !$drag] 1
    set selected_shape [db_shapes $current_object 0]
    if $drag {
	set oldm [bind all <B1-Motion>]
	set oldr [bind all <ButtonRelease-1>]
	bind all <B1-Motion> "drag_current_object_move %X %Y"
	bind all <ButtonRelease-1> [list drag_current_object_end $but $oldm $oldr]
    }
}

proc drag_current_object_move {xr yr} {
    global current_object selected_shape tdv_default
    
    if {$current_object == ""} return
    if ![info exists selected_shape] return
    
    set x [expr $xr - [winfo rootx $tdv_default]]
    set y [expr $yr - [winfo rooty $tdv_default]]
    set mst [$current_object getval move_sections_together 0]
    $current_object setval move_sections_together 1
    
    $selected_shape configure -selected_loc [$selected_shape get_centroid]
    tdv_move_action $tdv_default 2 "" $x $y
    $current_object setval move_sections_together $mst
    if ![$selected_shape get -visible] {
	foreach sh [db_shapes $current_object] {
	    $sh configure -visible 1
	    update_decorations $sh
	}
    }
}

proc drag_current_object_end {but oldm oldr} {
    global selected_shape current_object drag_creating_object
    
    if ![info exists drag_creating_object] return
    unset drag_creating_object
    
    if ![info exists selected_shape] return
    
    if ![$selected_shape get -visible] {
	foreach sh [db_shapes $current_object] { $sh configure -visible 1 }
    }
    
    bind all <B1-Motion> $oldm
    bind all <ButtonRelease-1> $oldr
    unset selected_shape
}

# ------------------------------------------------------------------------

proc app_domain_autoscale {{factor 1.0} {complain 1}} {
    global model_container domain default_autoscale_factor type_name
    
    if {[[db_shapes $domain 0] get -shtype] == "none"} {
	user_error "The $type_name(domain) type is \"None\" - can't do autoscale."
	return
    }
    
    if {$factor != "1.0"} {
	set factor [question "Scale factor?" $factor]
	if {$factor == ""} return
    }
    set default_autoscale_factor $factor
    
    set bb [get_domain_bbox]
    if {$bb == ""} {
	if $complain { user_error "No objects are active - can't do autoscale." }
	return
    }
    set bmin [lindex $bb 0]; set bmax [lindex $bb 1]
    
    set diff ""
    set nbmin ""; set nbmax ""
    foreach i {0 1 2} {
	set m1 [lindex $bmin $i]; set m2 [lindex $bmax $i]
	lappend diff [expr ($m2 - $m1) * $factor]
	lappend nbmin [expr $m1 - ($factor - 1.0) * ($m2 - $m1)]
	lappend nbmax [expr $m2 + ($factor - 1.0) * ($m2 - $m1)]
    }
    set bmin $nbmin
    set bmax $nbmax
    
    app_domain_set $bmin $bmax $diff
}

proc app_domain_set {bmin bmax diff} {
    global domain
    
    set sh [db_shapes $domain 0]
    set vals [list [list point1 [$sh si_value point1] $bmin] \
		  [list point2 [$sh si_value point2] $bmax] \
		  [list diff_flag [$sh getval diff_flag]]]
    if {$diff != ""} {
	lappend vals [list diff [$sh si_value diff] $diff]
    }
    $sh setval -noconstr point1 $bmin point2 $bmax diff $diff
    undo_record_change_shape $sh $vals
    edit_reset_params
    if {[info command app_clean_up_domain] != ""} {
	app_clean_up_domain $domain
    }
    db_dirty mesh
}

# This would get called if you had a "none" domain and converted to a real
# type.

proc app_initialize_domain {obj shape sectname domain} {
    global default_autoscale_factor
    if {($shape == "") || ([$shape get -type] != "shape_hexa")} { return 0 }
    set bb [get_domain_bbox $default_autoscale_factor]
    if {$bb == ""} { return 0 }
    $shape setval -noconstr point1 [lindex $bb 0] point2 [lindex $bb 1]
    return 1
}

proc get_domain_bbox {{scale 1} {except ""} {inc_slack 1}} {
    global default_autoscale_factor
    
    set cadbb [cad_get_bbox]
    if {$cadbb != ""} {
	set bmin [lindex $cadbb 0]; set bmax [lindex $cadbb 1]; set n 1
    } else {
	set bmin "0 0 0"; set bmax "0 0 0"; set n 0
    }
    foreach obj [db_list_objects_recursive] {
	foreach sh [db_shapes $obj] {
	    set obj [$sh get -object]
	    if {![$obj si_value active] || ([$obj getval obtype] == "domain") ||
		([$sh get -shtype] == "none") || [$obj getval no_geometry_modify 0]} continue
	    if {[lsearch $except $obj] >= 0} continue
	    set min1 [lindex [$sh get_bbox] 0]
	    set max1 [lindex [$sh get_bbox] 1]
	    if {($min1 == "") || ($max1 == "")} continue ;# shouldn't happen?
	    set nslack [expr {([$sh get -shtype] == "container") && !$inc_slack}]
	    foreach i {0 1 2} x {x y z} {
		set mini [lindex $min1 $i]; set maxi [lindex $max1 $i]
		if $nslack {
		    set mini [expr $mini + [$sh getval min${x}_slack]]
		    set maxi [expr $maxi - [$sh getval max${x}_slack]]
		}
		if {!$n || ([lindex $bmin $i] > $mini)} {
		    set bmin [lreplace $bmin $i $i $mini]
		}
		if {!$n || ([lindex $bmax $i] < $maxi)} {
		    set bmax [lreplace $bmax $i $i $maxi]
		}
	    }
	    incr n
	}
    }
    
    if $n {
	set bmin1 ""; set bmax1 ""
	foreach i {0 1 2} {
	    set d [expr ([lindex $bmax $i] - [lindex $bmin $i]) * ($scale - 1)]
	    lappend bmin1 [expr [lindex $bmin $i] - $d]
	    lappend bmax1 [expr [lindex $bmax $i] + $d]
	}
	return [list $bmin1 $bmax1]
    } else {
	return ""
    }
}


# ======================================================================
# ++++++++++Multi-shape/complex objects bottom edit window++++++++++++++
# This replaces shape based edit windows for the objects where geometry is
# defined by model_data and shapes are derived from that
# invoked via app_make_edit_window_$obtype inside of edit_put_shape

proc fix_model_data {var sub op} {
    global shape_data current_shape current_object incline_angle_info
    global no_fix_shape_data model_data
    
    if {($current_object != "")} { 
	if { ($current_shape == "")} {
	    set sh [db_shapes $current_object 0]	    
	} else {
	    set sh $current_shape
	}
    }
    if {[info exists no_fix_shape_data] || ($current_object == "") ||
	($sub == "")} return
    if {[catch {
	set obj $current_object
	#edit_modify_params
	#if {$sub == "axis"} { edit_modify_params }
	set val $model_data($sub)
	set fn app_clean_up_[$current_object getval obtype]
	switch $sub {
	    plane {
		if [catch {$obj si_value plane} pl] return
		if {$model_data(plane) == -1} {
		    $obj setval plane -1
		    edit_reset_params 0		    
		} elseif {$model_data(plane) != $pl} {
		    if {$pl == -1} {
			$obj setval plane 0
		    } else {
			array set foo { 0 1 1 1 2 1 }
			unset foo($model_data(plane))
			unset foo($pl)
			set ax [array names foo] ;# clever
			if {$model_data(plane) == ($pl + 1) % 3} {
			    set rr 270
			} else {
			    set rr 90
			}			
			set xc [expr ([ $current_object si_value xs] + [ $current_object si_value xe])/2.0 ]
			set yc [expr ([ $current_object si_value ys] + [ $current_object si_value ye])/2.0 ]
			set zc [expr ([ $current_object si_value zs] + [ $current_object si_value ze])/2.0 ]
			set cent [list $xc $yc $zc]
			
			app_transform_[$current_object getval obtype] $sh rotate $ax $rr $cent
			# want the newly calculated stuff to be updated
			#			$obj rotate $ax $rr ""
			
			edit_reset_params
		    }
		    
			  
		    if {[info commands $fn] != ""} { $fn $current_object }
		    # what to do here?
		    undo_record_change_shape $sh \
 			[list [list plane $pl $model_data(plane)]]
		    edit_reset_params 0
		    update_decorations $sh
		    db_dirty mesh
		}
	    }
	}
	
    } res] == 1} { puts "ERROR in fix_model_data: $res" }
}


proc edit_plane_widgets_model {w r allow_none} {
    label $w.pl -text Plane
    
    set func "list {0 Y-Z} {1 X-Z} {2 X-Y}"   
    futil_menuentry_labels $w.pm model_data(plane) $func \
	"" "" "" 3
    blt_table $w $w.pl $r,1 -anchor e
    blt_table $w $w.pm $r,2 -fill x
    
    return    
}

proc fix_diff_flag_label_model {args} {
    global model_data diff_flag_windows diff_flag_grid_info
    
    if {![info exists model_data(diff_flag)] || \
	    ($model_data(diff_flag) == "")} return
    set want ""
    switch $model_data(diff_flag) {
	0 { set want "xs ys zs xe ye ze" }
	1 { set want "xs ys zs xd yd zd" }
	2 { set want "xs ys zs xd2 yd2 zd2 rotate_angle" }
    }
    

    if [info exists diff_flag_windows] {
	foreach wins $diff_flag_windows {
	    foreach w $wins {
		foreach sub {xs ys zs xe ye ze xd yd zd xd2 yd2 zd2 rotate_angle} {
		    set ww $w$sub
		    if ![winfo exists $ww] continue
		    if {[lsearch $want $sub] >= 0}  {
			if [info exists diff_flag_grid_info($ww)] {
			    eval grid $ww $diff_flag_grid_info($ww)
			    unset diff_flag_grid_info($ww)
			}
		    } else {
			set inf [grid info $ww]
			if {$inf != ""} {
			    grid forget $ww
			    set diff_flag_grid_info($ww) $inf
			}
		    }
		}
	    }
	}
    }
    # fire off the traces to blank out non-used fields
    if [info exists model_data(axis)] {
	set model_data(axis) $model_data(axis)
    }
}

proc put_diff_model_menu {w r incl {col 1}} {
    global diff_flag_windows

    set func list
    lappend func [list 0 "Start / end"]
    lappend func [list 1 "Start / length"]
    if $incl {
	lappend func [list 2 "Start / angle"]
    }
    
    futil_menuentry_labels $w.dif model_data(diff_flag) $func \
	"$r $col -cols 4 -sticky {}" "" edit_modify_params
    
    lappend diff_flag_windows [list $w.l $w.e]
}

proc update_edit_window_model_quad {w nv {update_cmd ""}} {
    global input_inactivef model_data
    if {($nv && ![winfo exists $w]) || \
	    ![info exists model_data(plane)]} return
    if [catch {
	foreach v {xe ye ze xd yd zd} {
	    $w.l$v configure -foreground black
	    $w.e$v.e configure -state normal -foreground black
	}
	
	if {$model_data(plane)!= ""} {
	    set v [lindex {x y z} $model_data(plane)]
	    if {$update_cmd != "" } {
		app_update_params_${model_data(obtype)}
	    }
	    
	}
	foreach x {e d} {
	    $w.l${v}$x configure -foreground #b0b0b0
	    $w.e${v}$x.e configure -state disabled -foreground #b0b0b0
	}
    } res] { puts "ERROR in update_edit_window_model_quad: $res" }
}


proc app_make_edit_window_model_quad {w {update_cmd ""}} {
    global model_data
    edit_plane_widgets_model $w 0 0    
    trace variable model_data(plane) w "update_edit_window_model_quad $w 1 $update_cmd; list"
    put_diff_model_menu $w 0 0 3
    set ents ""
    
    set vs {
	xS xs 0 1 1
	yS ys 1 2 1
	zS zs 2 3 1
	xE xe 0 1 3
	yE ye 1 2 3 
	zE ze 2 3 3
	xL xd 0 1 3
	yL yd 1 2 3
	zL zd 2 3 3
    }
    
    foreach {v1 v2 v3 r c} $vs {
	edit_win_label $w.l$v2 $v1 $v2 $v3 model_data
	if {$v3 >= 0} {
	    model_unitentry $w.e$v2 model_data($v2) length ""
	    lappend ents $w.e$v2.e
	} else {
	    entry $w.e$v2 -textvariable model_data($v2)
	    lappend ents $w.e$v2
	}
	blt_table $w $w.l$v2 $r,$c -anchor e
	blt_table $w $w.e$v2 $r,[expr $c + 1] -fill x
    }
#    after idle "update_edit_window_model_quad $w 0"
    update_edit_window_model_quad $w 0 $update_cmd
    
    fix_diff_flag_label_model
    
    return $ents
}


proc update_edit_window_model_hexa {w nv} {
    global input_inactivef model_data
    if [catch {
	foreach v {xe ye ze xd yd zd} {
	    $w.l$v configure -foreground black
	    $w.e$v.e configure -state normal -foreground black
	}
    } res] { puts "ERROR in update_edit_window_model_hexa: $res" }
}


proc app_make_edit_window_model_hexa {w} {
    global model_data

    put_diff_model_menu $w 0 0 2
    set ents ""
    
    set vs {
	xS xs 0 1 1
	yS ys 1 2 1
	zS zs 2 3 1
	xE xe 0 1 3
	yE ye 1 2 3 
	zE ze 2 3 3
	xL xd 0 1 3
	yL yd 1 2 3
	zL zd 2 3 3
    }
    
    foreach {v1 v2 v3 r c} $vs {
	edit_win_label $w.l$v2 $v1 $v2 $v3 model_data
	if {$v3 >= 0} {
	    model_unitentry $w.e$v2 model_data($v2) length ""
	    lappend ents $w.e$v2.e
	} else {
	    entry $w.e$v2 -textvariable model_data($v2)
	    lappend ents $w.e$v2
	}
	blt_table $w $w.l$v2 $r,$c -anchor e
	blt_table $w $w.e$v2 $r,[expr $c + 1] -fill x
    }
#    after idle "update_edit_window_model_quad $w 0"
    update_edit_window_model_hexa $w 0
    
    fix_diff_flag_label_model

    return $ents
}

# ---------------------------------------------------

proc texture_list {} {
    global graph_texture_id
    
    set ret ""
    foreach f [array names graph_texture_id] {
	lappend ret $f ;# [file tail $f] not good
    }
    if {$ret != ""} { lappend ret "" }
    lappend ret "No texture"
    lappend ret "Load from file"
    return $ret
    
}

proc texture_select {var} {
    global graph_texture_id model_data
    
    upvar \#0 $var lvar
    
    if {$lvar == "Load from file"} {
	set lvar [file_selection -message "Select a PPM file for the texture." \
		    -file_types {{{PPM files} {.ppm}}}]
    } elseif {$lvar == "No texture"} {
	set lvar ""
    }
}
