
#
# Copyright (c) 2001 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#
# Tree viewing stuff.

proc tree_init {} {
    global tree env nonboldfont job_listsort tree_frame tree_icon_prefix
    global tree_on_left is_iceboard is_airpak
    
    if {![info exists env(ICEPAK_USE_MENUBAR)] &&
	![info exists env(ICEM_USE_MENUBAR)]} return
    
    set tree(detail) 0
    set tree(showicons) 1
    set tree(showfull) 0
    set tree(disabled) 0
    set tree(frame) $tree_frame
    set tree(selection) ""
    set tree(selection_message) ""
    
    set sw [ScrolledWindow $tree_frame.t]
    set tree(win) $sw.t
    Tree $tree(win) -relief flat -borderwidth 0 -width 1 -background white \
	-linesfill gray50 -dragenabled 1 -dropenabled 1 \
	-dragevent 1 -dropovermode n -draginitcmd tree_can_drag \
	-dropovercmd tree_can_drop -dropcmd tree_do_drop \
	-opencmd "tree_open_close_node 1" -closecmd "tree_open_close_node 0" \
	-selectcommand "tree_handle_select"
    $sw setwidget $sw.t
    tree_reconfigure
    
    foreach tt {Text Image} {
	$tree(win) bind$tt <ButtonRelease-1> tree_single_click
	$tree(win) bind$tt <Double-1> tree_double_click
	$tree(win) bind$tt <Shift-ButtonRelease-1> tree_shift_click
	$tree(win) bind$tt <Control-ButtonRelease-1> tree_control_click
	$tree(win) bind$tt <3> "tree_rightmenu %X %Y"
	$tree(win) bind$tt <Enter> "tree_highlight 1"
	$tree(win) bind$tt <Leave> "tree_highlight 0"
	$tree(win) bind$tt <Button-1> ""
    }
    catch {
	bind $tree(win).c <Return> tree_hit_return
    }
    
    set icons [file dirname $tree_icon_prefix]
    foreach but {lessdetail moredetail nextchoice prevchoice} {
	image create bitmap $but -file $icons/icepak_$but.xbm \
	    -foreground black -background ""
    }
    
    label $tree(frame).botlabel -textvariable tree(selection_message) \
	-fg red -anchor w
    frame $tree(frame).toolbar -relief flat -borderwidth 0
    toolbar_register_frame object_tools $tree(frame).toolbar 1
    
    if [info exists tree_on_left] {
	set col_b 1
	set col_t 0
    } else {
	set col_b 0
	set col_t 1
    }
    
    grid $tree(frame).toolbar -row 0 -column $col_b -rowspan 2 -sticky nwes
#    grid $tree(frame).f -row 0 -column $col_t -sticky nw
    grid $sw -row 1 -column $col_t -sticky nwes
    grid $tree(frame).botlabel -row 2 -column 0 -columnspan 2 -sticky ew
    grid rowconfigure $tree(frame) 0 -weight 0
    grid rowconfigure $tree(frame) 1 -weight 10000
    grid rowconfigure $tree(frame) 2 -weight 0
    grid columnconfigure $tree(frame) $col_b -weight 0
    grid columnconfigure $tree(frame) $col_t -weight 10000
    
    tree_build
    
    if $is_iceboard {
	tree_make_popup_menus_iceboard
    } elseif $is_airpak {
	tree_make_popup_menus_airpak
    } else {
	tree_make_popup_menus
    }
}

proc tree_find_form {} {
    set buts [list close { Next tree_search_next } { Prev tree_search_prev }]
    set d [form_init .tree_find "Find in tree" "" $buts]
    if {$d != ""} {
	form_label $d.lab "Find object name" {0 0}
	form_entry $d.ent tree(search) string {0 1}
	bind $d.ent <Return> tree_search_next
	form_finish +300+300
    }
}

proc tree_open_close_all {open {tree_node root}} {
    global tree
    
    set chs [$tree(win) nodes $tree_node]
    foreach ch $chs {
	if $open {
	    if {$ch == "model/material"} continue
	    $tree(win) opentree $ch
	} else {
	    $tree(win) closetree $ch
	}
    }
    if {$tree_node != "root"} {
	$tree(win) itemconfigure $tree_node -open $open
    }
}

proc tree_descendants {tr node} {
    set ret $node
    foreach ch [$tr nodes $node] {
	set ret [concat $ret [tree_descendants $tr $ch]]
    }
    return $ret
}

proc tree_edit_current_selection {} {
    global tree no_multiple_edit
    
    set objs [tree_list_selected]
    if {$objs != ""} {
	if {[llength $objs] == 1} {
            tree_select_object [lindex $objs 0]
	    edit_current_object
	} else {
	    set obtype [[lindex $objs 0] getval obtype]
	    if [info exists no_multiple_edit($obtype)] {
		user_error "Can't edit more than one $obtype at a time"
		return
	    }
	    set to_edit ""
	    set not 0
	    foreach obj $objs {
		if {[$obj getval obtype] == $obtype} {
		    lappend to_edit $obj
		} else {
		    incr not
		}
	    }
	    if $not {
		user_error "$not objects were not of type $obtype and so are being ignored"
	    }
	    edit_multiple_objects $obtype $to_edit
	}
    } else {
	# Just do the double-click thing on the first selected node.
	set node [lindex [$tree(win) selection get] 0]
	if {$node == ""} {
	    user_error "Nothing is selected in the tree to edit"
	} else {
	    tree_double_click $node
	}
    }
}

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

proc tree_can_drag {xtree node {topl ""}} {
    global tree
    
    if [info exists tree(no_events)] { return "" }
    
    if {[lsearch [$xtree selection get] $node] < 0} {
	tree_single_click $node
    }
    
    if ![$xtree exists $node] { return "" } ;# should never happen ...
    
    set data [$xtree itemcget $node -data]
    switch [lindex $data 0] {
        object_node - trash_object_node {
	    set obj [lindex $data 1]
	    switch [$obj getval obtype] {
		default {
		    # It sometimes happens that $topl is a nonexistent window.
		    if {($topl != "") && [winfo exists $topl]} {
			# This is the same stuff as in Tree::_init_drag_cmd
			set img [$xtree itemcget $node -image]
			if {$img != ""} {
			    if ![winfo exists $topl.l] {
				pack [label $topl.l -padx 0 -pady 0]
			    }
			    $topl.l configure -image $img
			}
		    }
		    return [list TREE_NODE move $node]
		}
	    }
	}
	library_object_node {
	    if {$topl != ""} {
		# This is the same stuff as in Tree::_init_drag_cmd
		set img [$xtree itemcget $node -image]
		if {$img != ""} {
		    pack [label $topl.l -image $img -padx 0 -pady 0]
		}
	    }
	    return [list TREE_NODE move $node]
	}
        group_node {
	    return [list TREE_NODE move $node]
	}
        post_object_node {
	    return [list TREE_NODE move $node]
	}
        named_point_node {
	    return [list TREE_NODE move $node]
	}
	default { return "" }
    }
}

proc tree_can_drop {xtree dummy droploc op dtype node} {
    global object_type_can_change materials_used_by_objects
    global profiles_used_by_objects tree

    if [info exists tree(no_events)] { return "2 node" }
    
    set dest [lindex $droploc 1]
    set ddata [$xtree itemcget $dest -data]
    set sdata [$xtree itemcget $node -data]
    switch [lindex $sdata 0] {
	object_node {
	    set sobj [lindex $sdata 1]
	    if {[$sobj getval obtype] == "material"} {
		switch [lindex $ddata 0] {
		    object_node {
			set dobj [lindex $ddata 1]
			set mtype [$sobj getval mat_type]
			set obtype [$dobj getval obtype]
			if ![info exists materials_used_by_objects($obtype,$mtype)] {
			    return "2 node"
			} else {
			    return "3 node"
			}
		    }
		    trash_node {
			if {[$sobj getval mat_lib_path ""] != ""} {
			    return "2 node"
			} else {
			    return "3 node"
			}
		    }
		    library_node {
			return "3 node"
		    }
		    default { return "2 node" }
		}
	    } elseif {[$sobj getval obtype] == "profile"} {
		switch [lindex $ddata 0] {
		    object_node {
			set dobj [lindex $ddata 1]
			set mtype [$sobj si_value prof_type]
			set obtype [$dobj getval obtype]
			if ![info exists profiles_used_by_objects($obtype,$mtype)] {
			    return "2 node"
			} else {
			    return "3 node"
			}
		    }
		    trash_node {
			if [$sobj getval from_library 0] {
			    return "2 node"
			} else {
			    return "3 node"
			}
		    }
		    default { return "2 node" }
		}				
	    } else {
		switch [lindex $ddata 0] {
		    type_node {
			set type [lindex $ddata 1]
			if [info exists object_type_can_change([$sobj getval obtype],$type)] {
			    return "3 node"
			} else {
			    return "2 node"
			}
			return "3 node"
		    }
		    object_node {
			set dobj [lindex $ddata 1]
			if {$dobj == $sobj} { return "2 node" }
			switch [$dobj getval obtype] {
			    part {
				if [$sobj getval no_geometry_modify 0] {
				    return "2 node"
				} else {
				    return "3 node"
				}
			    }
			    domain { return "2 node" }
			    default {
				# This now does change priority
				
				if {[$xtree parent $node] == [$xtree parent $dest]} {
				    return "3 node"
				} else {
				    return "2 node"
				}
				
				
				
				old stuff
				if [info exists object_type_can_change([$sobj getval obtype],[$dobj getval obtype])] {
				    return "3 node"
				} else {
				    return "2 node"
				}
			    }
			}
		    }
		    library_node { return "3 node" }
		    inactive_node { return "3 node" }
		    trash_node { return "3 node" }
		    model_node { return "3 node" }
		    group_node { return "3 node" }
		    named_point_container_node { return "3 node" }
		    default { return "2 node" }
		}
	    }
	}
	trash_object_node {
	    switch [lindex $ddata 0] {
		object_node {
		    set dobj [lindex $ddata 1]
		    switch [$dobj getval obtype] {
			part { return "3 node" }
			default { return "2 node" }
		    }
		}
		model_node { return "3 node" }
		inactive_node { return "3 node" }
		default { return "2 node" }
	    }
	}
	library_object_node {
	    set sobtype [lindex $sdata 3]
	    switch [lindex $ddata 0] {
		object_node {
		    set dobj [lindex $ddata 1]
		    switch [$dobj getval obtype] {
			part { return "3 node" }
			default { return "2 node" }
		    }
		}
		model_node { return "3 node" }
		library_node { return "3 node" }
		default { return "2 node" }
	    }
	}
	named_point_node {
	    switch [lindex $ddata 0] {
		trash_node { return "3 node" }
		default { return "2 node" }
	    }
	}
	post_object_node {
	    switch [lindex $ddata 0] {
		trash_node { return "3 node" }
		post_container_node { return "3 node" }
		inactive_node { return "3 node" }
		default { return "2 node" }
	    }
	}
	group_node {
	    switch [lindex $ddata 0] {
		group_node { return "3 node" }
		trash_node { return "3 node" }
		default { return "2 node" }
	    }
	}
    }
}

proc tree_do_drop {xtree dummy droploc op dtype dummynode} {
    global model_container_root edit_current_active domain tree is_iceboard

    set dest [lindex $droploc 1]
    if [catch {$xtree itemcget $dest -data} ddata] {
	mess "Internal error: the node $dest was not in the tree!\n" red
	return
    }
    
    # This is for speed.
    set move_dest ""
    set move_objects ""
    set move_dest_open 0
    
    if {[lindex $ddata 0] == "library_node"} {
	# This is different because we have to pull them all in together
	set objects ""
	set library_objects ""
	set materials ""
	foreach node [$xtree selection get] {
	    set sdata [$xtree itemcget $node -data]
	    set obj [lindex $sdata 1]
	    switch [lindex $sdata 0] {
		object_node {
		    if {[$obj getval obtype] == "material"} {
			lappend materials $obj
		    } elseif {$obj != $domain} {
			lappend objects $obj
		    }
		}
		library_object_node {
		    switch [lindex $sdata 0] {
			object_node {
			    if {[$obj getval obtype] == "material"} {
				lappend materials $obj
			    } else {
				lappend library_objects \
				    [lindex $sdata 1] [lindex $sdata 2]
			    }
			}
			library_object_node {
			    lappend library_objects \
				[lindex $sdata 1] [lindex $sdata 2]
			}
		    }
		}
	    }
	}
	if {$objects != ""} {
	    after idle [list library_save_objects [concat $domain $objects] \
			    [lindex $ddata 1] $dest]
	}
	if {$library_objects != ""} {
	    after idle [list library_copy_library_objects $library_objects \
			    [lindex $ddata 1] $dest]
	}
	if {$materials != ""} {
	    after idle [list mat_append_to_library $materials \
			    [lindex $ddata 1]]
	}
    }
    
    foreach node [$xtree selection get] {
	set sdata [$xtree itemcget $node -data]
	switch [lindex $sdata 0] {
	    object_node {

		set sobj [lindex $sdata 1]
		switch [lindex $ddata 0] {
		    type_node {
			set type [lindex $ddata 1]
			set parent [$xtree parent $dest]
			if {$parent == "model"} {
			    # This has to be after idle because
			    # otherwise the tree updating
			    # itself would interfere with the type change
			    set tree(no_events) 1
			    after idle "catch {unset tree(no_events)}; change_object_type $sobj $type"
			    
			} else {
			    set dobj [lindex [$xtree itemcget $parent -data] 1]
			    set open [$xtree itemcget $parent -open]
			    set tree(no_events) 1
			    after idle "catch {unset tree(no_events)}; part_move_object_into $parent $sobj $open; change_object_type $sobj $type"
			}
		    }
		    object_node {
			set dobj [lindex $ddata 1]
			switch [$dobj getval obtype] {
			    part - domain {
				#set open [$xtree itemcget $dobj -open]
				#after idle "part_move_object_into $dobj $sobj $open"
				set move_dest $dobj
				lappend move_objects $sobj
				set move_dest_open [$xtree itemcget $dobj -open]
			    }
			    default {
				set tree(no_events) 1
				if {[$sobj getval obtype] == "material"} {
				    after idle "catch {unset tree(no_events)}; mat_change_object_materials $dobj $sobj"
				} elseif {[$sobj getval obtype] == "profile"} {
				    after idle "catch {unset tree(no_events)}; prof_change_object_profiles $dobj $sobj"
				} else {
				    # This now does change priority
				    after idle "catch {unset tree(no_events)}; change_object_priority $sobj $dobj"
				    
				    # after idle "change_object_type $sobj [$dobj getval obtype]"
				}
			    }
			}
		    }
		    model_node {
			switch [$xtree parent $sobj] {
			    model {
				# This could happen if multiple nodes were
				# dragged from inactive to model - ignore
			    }
			    root {
				tree_tearoff_object $sobj
			    }
			    inactive {
				set edit_current_active 1
				after idle tree_toggle_current_active
			    }
			    default {
				set move_dest $model_container_root
				lappend move_objects $sobj
				set move_dest_open [$xtree itemcget model -open]
			    }
			}
		    }
		    trash_node {
			if {[lindex $sdata 2] == "in_group"} {
			    set pdata [$xtree itemcget [$xtree parent $node] -data]
			    coll_remove_object [lindex $pdata 1] $sobj
			    $xtree delete $node
			} else {
			    form_cancel_class model
			    set tree(no_events) 1
			    after idle "catch {unset tree(no_events)}; trash_add $sobj"
			    #edit_delete 1 $sobj
			}
		    }
		    inactive_node {
			set edit_current_active 0
			after idle tree_toggle_current_active
		    }
		    group_node {
			coll_add_object $dest $sobj
			$xtree opentree $dest
		    }
		    named_point_container_node {
			named_point_create $sobj
			$xtree opentree named_point_container
		    }
		}
	    }
	    trash_object_node {
		set make_inactive [expr {[lindex $ddata 0] == "inactive_node"}]
		set from [lindex $sdata 1]
		set to [lindex $ddata 1]
		if {$to == ""} { set to $model_container_root }
		set tree(no_events) 1
		after idle "catch {unset tree(no_events)}; trash_remove $from $to $make_inactive"
	    }
	    group_node {
		switch [lindex $ddata 0] {
 		    group_node {
			set from [lindex $sdata 1]
			set to [lindex $ddata 1]
			coll_merge $to $from
		    }
		    trash_node {
			coll_delete group [lindex $sdata 1]
			$xtree delete $node
		    }
		}
	    }
	    library_object_node {
		switch [lindex $ddata 0] {
		    model_node - object_node {
			set dobj [lindex $ddata 1]
			set dir [lindex $sdata 1]
			set file [lindex $sdata 2]
			library_load_object $dir $file $dobj [lindex $sdata 3]
		    }
		}
	    }
	    post_object_node {
		switch [lindex $ddata 0] {
		    trash_node {
			set obj [lindex $sdata 1]
			post_delete $obj
		    }
		    inactive_node {
			set obj [lindex $sdata 1]
			post_set_active $obj 0
		    }
		    post_container_node {
			set obj [lindex $sdata 1]
			post_set_active $obj 1
		    }
		}
	    }
	    named_point_node {
		switch [lindex $ddata 0] {
		    trash_node {
			set obj [lindex $sdata 1]
			named_point_delete $obj
		    }
		}
	    }
	}
    }
    if {$move_dest != ""} {
	set tree(no_events) 1
	if $is_iceboard {
	    # This is needed because otherwise the event mechanism messes up the tree
	    after idle {catch {unset tree(no_events)}; user_error {Sorry, you can't move objects in iceboard.}}
	    return
	} else {
	    after idle "catch {unset tree(no_events)}; part_move_object_into $move_dest \"$move_objects\" $move_dest_open"
	}
    }
}

proc tree_clear_clipboard {} {
    global tree
    if [info exists tree] { set tree(selection) "" }
}

proc tree_copy_to_clipboard {} {
    global tree
    set tree(selection) [$tree(win) selection get]
    set ns [llength $tree(selection)]
    if $ns {
	set tree(selection_message) "Clipboard: $ns item[expr {($ns > 1) ? "s" : ""}]"
    } else {
	set tree(selection_message) ""
    }
    $tree(win) selection clear
}

proc tree_paste_from_clipboard {} {
    global tree
    if {$tree(selection) == ""} {
	mess "Nothing in the clipboard\n" red
	return
    }
    set sel $tree(selection)
#    set tree(selection) ""
#    set tree(selection_message) ""
    
    set dest [lindex [$tree(win) selection get] 0]
    set dropping ""
    foreach node $sel {
	if {[tree_can_drop $tree(win) "" [list "" $dest] "" "" $node] == \
		"3 node"} {
	    lappend dropping $node
	}
    }
    if {$dropping != ""} {
	eval $tree(win) selection set $dropping
	tree_do_drop $tree(win) "" [list "" $dest] "" "" ""
    } else {
	mess "Sorry, can't paste those nodes in that location.\n" red
    }
}

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

proc tree_open_close_current {{nodes ""} {full 0}} {
    global tree
    
    if {$nodes == ""} { set nodes [$tree(win) selection get] }
    foreach node $nodes {
	if [$tree(win) itemcget $node -open] {
	    if $full {
		$tree(win) closetree $node
	    } else {
		$tree(win) itemconfigure $node -open 0
		tree_open_close_node 0 $node
	    }
	} else {
	    if $full {
		$tree(win) opentree $node
	    } else {
		$tree(win) itemconfigure $node -open 1
		tree_open_close_node 1 $node
	    }
	}
    }
}

proc tree_open_close_node {open node} {
    global tree model_container_root
    
    set data [$tree(win) itemcget $node -data]
    switch [lindex $data 0] {
	object_node {
	    set obj [lindex $data 1]
	    if {[$obj getval obtype] == "part"} {
		part_make_open $obj $open
	    }
	}
	model_node {
	    part_make_open $model_container_root $open
	}
	type_node {
	    if {[lindex $data 1] == "material"} {
		after idle load_materials
	    }
	}
	library_node - library_node_ro {
	    if $open {
		load_materials
	    }
	}
	named_point_container_node {
	    named_point_show_all $open
	}
    }
    if {$open && [info exists tree(when_first_open,$node)]} {
	set cmd $tree(when_first_open,$node)
	unset tree(when_first_open,$node)
	eval $cmd
    }
}

proc tree_check_node_opened {name} {
    global tree
    return [$tree(win) itemcget $name -open]
}

proc tree_set_node_open {node open} {
    global tree
    $tree(win) itemconfigure $node -open $open
}

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

proc tree_reconfigure {} {
    global tree
    if $tree(showicons) {
	$tree(win) configure -deltay 21 -deltax 7 -padx 22
    } else {
	$tree(win) configure -deltay 15 -deltax 7 -padx 2
    }
}

proc tree_make_popup_menus {} {
    global tree object_type_list type_name
    
    foreach mm {objectmenu objectingroup_menu} {
	menu $tree(win).$mm -tearoff 0
	
	$tree(win).$mm add command -label [form_label_text "Add to clipboard"] \
	    -command "tree_copy_to_clipboard"
	$tree(win).$mm add command -label [form_label_text "Paste from clipboard"] \
	    -command "tree_paste_from_clipboard"
	
	#set sm $tree(win).$mm.changetype
	#tree_create_types_menu $sm changetype
	#$tree(win).$mm add cascade -label [form_label_text "Change type"] -menu $sm
	
	$tree(win).$mm add command -label [form_label_text "Rename"] \
	    -command "tree_rename"
	$tree(win).$mm add command -label [form_label_text "Copy object"] \
	    -command "edit_move 1"
	$tree(win).$mm add command -label [form_label_text "Move object"] \
	    -command "edit_move 0"
	$tree(win).$mm add command -label [form_label_text "Edit object"] \
	    -command tree_edit_current_selection
	$tree(win).$mm add command -label [form_label_text "Delete"] \
	    -command tree_delete_selected
	$tree(win).$mm add command -label [form_label_text "Create $type_name(part)"] \
	    -command tree_part_from_selected
	$tree(win).$mm add command -label [form_label_text "Create group"] \
	    -command tree_group_from_selected
	$tree(win).$mm add checkbutton -label [form_label_text "Active"] \
	    -variable edit_current_active -command tree_toggle_current_active
	$tree(win).$mm add checkbutton -label [form_label_text "Visible"] \
	    -variable edit_current_visible -command tree_toggle_current_visible
	$tree(win).$mm add command -label [form_label_text "Total volume"] \
	    -command "tree_object_compute volume"
	$tree(win).$mm add command -label [form_label_text "Total area"] \
	    -command "tree_object_compute area"
	$tree(win).$mm add command -label [form_label_text "Create monitor point"] \
	    -command "tree_object_create_mon_pt"
	$tree(win).$mm add command -label [form_label_text "Edit mesh parameters"] \
	    -command "tree_object_edit_mesh_params"
	$tree(win).$mm add command -label [form_label_text "Create object face"] \
	    -command "tree_object_post_face"
	
    }
    $tree(win).objectingroup_menu add separator
    $tree(win).objectingroup_menu add command -label [form_label_text "Remove from group"] \
	-command "tree_remove_from_group_action"
    
    # -------------------------------------------
    
    foreach mm {objectmenu objectingroup_menu} {
	menu $tree(win).domain_$mm -tearoff 0
	
	$tree(win).domain_$mm add command -label [form_label_text "Add to clipboard"] \
	    -command "tree_copy_to_clipboard"
	$tree(win).domain_$mm add command -label [form_label_text "Paste from clipboard"] \
	    -command "tree_paste_from_clipboard"
	
	$tree(win).domain_$mm add command -label [form_label_text "Rename"] \
	    -command "tree_rename"
	$tree(win).domain_$mm add command -label [form_label_text "Move object"] \
	    -command "edit_move 0"
	$tree(win).domain_$mm add command -label [form_label_text "Edit object"] \
	    -command tree_edit_current_selection
	$tree(win).domain_$mm add checkbutton -label [form_label_text "Visible"] \
	    -variable edit_current_visible -command tree_toggle_current_visible
	$tree(win).domain_$mm add command -label [form_label_text "Total volume"] \
	    -command "tree_object_compute volume"
	$tree(win).domain_$mm add command -label [form_label_text "Total area"] \
	    -command "tree_object_compute area"
    }
    $tree(win).domain_objectingroup_menu add separator
    $tree(win).domain_objectingroup_menu add command -label [form_label_text "Remove from group"] \
	-command "tree_remove_from_group_action"
    
    # -------------------------------------------
    
    set mm part_objectingroup_menu
    
    menu $tree(win).$mm -tearoff 0
    
    $tree(win).$mm add command -label [form_label_text "Add to clipboard"] \
	-command "tree_copy_to_clipboard"
    $tree(win).$mm add command -label [form_label_text "Paste from clipboard"] \
	-command "tree_paste_from_clipboard"
    $tree(win).$mm add command -label [form_label_text "Rename"] \
	-command "tree_rename"
    $tree(win).$mm add command -label [form_label_text "Copy object"] \
	-command "edit_move 1"
    $tree(win).$mm add command -label [form_label_text "Move object"] \
	-command "edit_move 0"
    $tree(win).$mm add command -label [form_label_text "Edit object"] \
	-command tree_edit_current_selection
    $tree(win).$mm add command -label [form_label_text "Delete"] \
	-command tree_delete_selected
    $tree(win).$mm add command -label [form_label_text "Create group"] \
	-command tree_group_from_selected
    $tree(win).$mm add command -label [form_label_text "Remove from group"] \
	-command "tree_remove_from_group_action"
    $tree(win).$mm add command -label [form_label_text "Total volume"] \
	-command "tree_object_compute volume"
    $tree(win).$mm add command -label [form_label_text "Total area"] \
	-command "tree_object_compute area"
    
    # -------------------------------------------
    
    menu $tree(win).typemenu -tearoff 0
    if 0 {
	$tree(win).typemenu add command -label [form_label_text "Create"] \
	    -command edit_new
	$tree(win).typemenu add command -label [form_label_text "Spreadsheet"] -command tree_spreadsheet
	$tree(win).typemenu add checkbutton -label [form_label_text "Visible"] \
	    -variable tree(this_type_visible) -command tree_update_type_visible
    }
    
    # -------------------------------------------
    
    menu $tree(win).part_objectmenu -tearoff 0
    
    $tree(win).part_objectmenu add command -label [form_label_text "Add to clipboard"] \
	-command "tree_copy_to_clipboard"
    $tree(win).part_objectmenu add command -label [form_label_text "Paste from clipboard"] \
	-command "tree_paste_from_clipboard"
    
    set sm $tree(win).part_objectmenu.create
    tree_create_types_menu $sm inpart
    $tree(win).part_objectmenu add cascade -label [form_label_text "Create"] -menu $sm
    
    $tree(win).part_objectmenu add command -label [form_label_text "Merge project"] \
	-command "tree_merge_job"
    $tree(win).part_objectmenu add command -label [form_label_text "Load $type_name(part)"] \
	-command "tree_load_part 1"
    $tree(win).part_objectmenu add command -label [form_label_text "Save as project"] \
	-command "tree_save_part"
    
    $tree(win).part_objectmenu add checkbutton -label [form_label_text "View separately"] \
	-variable tree(object_is_separate) -command tree_tearoff_object
    
    $tree(win).part_objectmenu add separator
	
    $tree(win).part_objectmenu add command -label [form_label_text "Rename"] \
	-command "tree_rename"
    $tree(win).part_objectmenu add command -label [form_label_text "Copy object"] \
	-command "edit_move 1"
    $tree(win).part_objectmenu add command -label [form_label_text "Move object"] \
	-command "edit_move 0"
    $tree(win).part_objectmenu add command -label [form_label_text "Edit object"] \
	-command tree_edit_current_selection
    $tree(win).part_objectmenu add command -label [form_label_text "Delete"] \
	-command tree_delete_selected
    $tree(win).part_objectmenu add command -label [form_label_text "Create $type_name(part)"] \
	-command tree_part_from_selected
    $tree(win).part_objectmenu add checkbutton -label [form_label_text "Active"] \
	-variable edit_current_active -command tree_toggle_current_active
    $tree(win).part_objectmenu add checkbutton -label [form_label_text "Visible"] \
	-variable edit_current_visible -command tree_toggle_current_visible
    $tree(win).part_objectmenu add command -label [form_label_text "Open subtree"] \
	-command "tree_opentree_current 1"
    $tree(win).part_objectmenu add command -label [form_label_text "Close subtree"] \
	-command "tree_opentree_current 0"
     $tree(win).part_objectmenu add command -label [form_label_text "Summary information"] \
	-command "part_view_summary"
    $tree(win).part_objectmenu add command -label [form_label_text "Total volume"] \
	-command "tree_object_compute volume"
    $tree(win).part_objectmenu add command -label [form_label_text "Total area"] \
	-command "tree_object_compute area"
    
    # -------------------------------------------
    
    foreach mm {material material_model} {
	menu $tree(win).${mm}_objectmenu -tearoff 0
	$tree(win).${mm}_objectmenu add command -label [form_label_text "Add to clipboard"] \
	    -command "tree_copy_to_clipboard"
	$tree(win).${mm}_objectmenu add command -label [form_label_text "Copy material"] \
	    -command "edit_move 1"
	$tree(win).${mm}_objectmenu add command -label [form_label_text "Rename"] \
	    -command "tree_rename"
	$tree(win).${mm}_objectmenu add command -label [form_label_text "Edit"] \
	    -command tree_edit_current_selection
    }
    
    $tree(win).material_model_objectmenu add command -label [form_label_text "Delete"] \
	-command tree_delete_selected
    
    # -------------------------------------------
    
    menu $tree(win).profile_objectmenu -tearoff 0
    $tree(win).profile_objectmenu add command -label [form_label_text "Add to clipboard"] \
	-command "tree_copy_to_clipboard"
    $tree(win).profile_objectmenu add command -label [form_label_text "Rename"] \
	-command "tree_rename"
    $tree(win).profile_objectmenu add command -label [form_label_text "Edit"] \
	-command tree_edit_current_selection
    
    # -------------------------------------------
    
    menu $tree(win).subtypemenu -tearoff 0
    if 0 {
	$tree(win).subtypemenu add command -label [form_label_text "Create"] \
	    -command edit_new
	$tree(win).subtypemenu add command -label [form_label_text "Spreadsheet"] \
	    -command tree_spreadsheet
    }
    
    # -------------------------------------------
    
    menu $tree(win).librarymenu -tearoff 0
    $tree(win).librarymenu add command -label [form_label_text "Edit info"] \
	-command "tree_edit_library_info"
    $tree(win).librarymenu add command -label [form_label_text "Paste from clipboard"] \
	-command "tree_paste_from_clipboard"
    $tree(win).librarymenu add command -label [form_label_text "Refresh"] \
	-command "tree_make_library_subtree 1"
    
    # -------------------------------------------
    
    menu $tree(win).librariesmenu -tearoff 0
    $tree(win).librariesmenu add command -label [form_label_text "Create new"] \
	-command "file_libraries 1"
    
    # -------------------------------------------
    
    menu $tree(win).monitorcontainermenu -tearoff 0
    $tree(win).monitorcontainermenu add command -label [form_label_text "Create at location"] \
	-command "named_point_edit"
    $tree(win).monitorcontainermenu add command -label [form_label_text "Paste from clipboard"] \
	-command "tree_paste_from_clipboard"
    
    # -------------------------------------------
    
    menu $tree(win).inactivecontainermenu -tearoff 0
    $tree(win).inactivecontainermenu add command -label [form_label_text "Paste from clipboard"] \
	-command "tree_paste_from_clipboard"
	
    # -------------------------------------------
    
    menu $tree(win).monitorpointmenu -tearoff 0
    $tree(win).monitorpointmenu add command -label [form_label_text "Edit info"] \
	-command "tree_named_point_edit"
    $tree(win).monitorpointmenu add command -label [form_label_text "Move"] \
	-command "tree_named_point_copy_move 0"
    $tree(win).monitorpointmenu add command -label [form_label_text "Copy"] \
	-command "tree_named_point_copy_move 1"
    $tree(win).monitorpointmenu add command -label [form_label_text "Delete"] \
	-command "tree_named_point_delete_cmd"
    
    # -------------------------------------------
    
    menu $tree(win).grouptypemenu -tearoff 0
    $tree(win).grouptypemenu add command -label [form_label_text "Create"] \
	-command "coll_create group __ask__"
    
    # -------------------------------------------
    
    menu $tree(win).groupmenu -tearoff 0
    
    $tree(win).groupmenu add command -label [form_label_text "Paste from clipboard"] \
	-command "tree_paste_from_clipboard"
    
    foreach which {add remove} {
	menu $tree(win).groupmenu.$which -tearoff 0
	$tree(win).groupmenu.$which add command -label [form_label_text "Screen select"] \
	    -command "coll_op group $which"
	$tree(win).groupmenu.$which add command -label [form_label_text "Screen region"] \
	    -command "coll_region group $which"
	$tree(win).groupmenu.$which add command -label [form_label_text "Name/pattern"] \
	    -command "coll_pattern group $which"
    }
    
    $tree(win).groupmenu add separator
    
    $tree(win).groupmenu add command -label [form_label_text "Properties"] \
	-command "coll_edit_parameters \$coll_current"
    $tree(win).groupmenu add command -label [form_label_text "Rename"] \
	-command "coll_rename"
    $tree(win).groupmenu add command -label [form_label_text "Delete"] \
	-command "coll_delete_action group"
    
    $tree(win).groupmenu add separator
    
#    $tree(win).groupmenu add command -label [form_label_text "Merge"] \
\#	-command "coll_merge group \$coll_current"
    $tree(win).groupmenu add cascade -label [form_label_text "Add"] \
	-menu $tree(win).groupmenu.add
    $tree(win).groupmenu add cascade -label [form_label_text "Remove"] \
	-menu $tree(win).groupmenu.remove
    
    $tree(win).groupmenu add separator
    
    $tree(win).groupmenu add command -label [form_label_text "Copy group"] \
	-command "coll_copy group"
    $tree(win).groupmenu add command -label [form_label_text "Move group"] \
	-command "coll_move group"
    $tree(win).groupmenu add command -label [form_label_text "Edit objects"] \
	-command "coll_properties group"
    
    $tree(win).groupmenu add separator
    
    $tree(win).groupmenu add checkbutton -label [form_label_text "Visible"] \
	-variable coll_current_shading -offvalue [form_label_text "Invisible"] \
	-onvalue "" -command coll_reconfigure_visible
    $tree(win).groupmenu add command -label [form_label_text "Activate all"] \
	-command "coll_act_all group 1"
    $tree(win).groupmenu add command -label [form_label_text "Deactivate all"] \
	-command "coll_act_all group 0"
    $tree(win).groupmenu add command -label [form_label_text "Delete all"] \
	-command "coll_del_all group"
    $tree(win).groupmenu add command -label [form_label_text "Total volume"] \
	-command "tree_object_compute volume"
    $tree(win).groupmenu add command -label [form_label_text "Total area"] \
	-command "tree_object_compute area"
    
    $tree(win).groupmenu add separator
    
    $tree(win).groupmenu add command -label [form_label_text "Create $type_name(part)"] \
	-command "coll_create_part group"
    $tree(win).groupmenu add command -label [form_label_text "Copy params"] \
	-command "coll_copy_props group 1"
    $tree(win).groupmenu add command -label [form_label_text "Save as project"] \
	-command "coll_save_as_job"
    
    # -------------------------------------------
    
    menu $tree(win).modelmenu -tearoff 0
    $tree(win).modelmenu add command -label [form_label_text "Paste from clipboard"] \
	-command "tree_paste_from_clipboard"
    set sm $tree(win).modelmenu.create
    tree_create_types_menu $sm notinpart
    $tree(win).modelmenu add cascade -label [form_label_text "Create"] -menu $sm
    $tree(win).modelmenu add command -label [form_label_text "Merge project"] \
	-command "tree_merge_job"
    $tree(win).modelmenu add command -label [form_label_text "Load $type_name(part)"] \
	-command "tree_load_part 0"
    
    # -------------------------------------------
    
    menu $tree(win).trashmenu -tearoff 0
    $tree(win).trashmenu add command -label [form_label_text "Paste from clipboard"] \
	-command "tree_paste_from_clipboard"
    $tree(win).trashmenu add command -label [form_label_text "Empty trash"] \
	-command "trash_empty"
    
    menu $tree(win).trashobjectmenu -tearoff 0
    $tree(win).trashobjectmenu add command -label [form_label_text "Undelete"] \
	-command "tree_trash_remove_selected"
    
    # -------------------------------------------
    
    menu $tree(win).postobjectmenu -tearoff 0
    $tree(win).postobjectmenu add checkbutton -label [form_label_text "Active"] \
	-variable post_current_active -command post_set_active
    $tree(win).postobjectmenu add command -label [form_label_text "Edit"] \
	-command post_edit
    $tree(win).postobjectmenu add command -label [form_label_text "Delete"] \
	-command tree_delete_selected
    
    # -------------------------------------------
    
    menu $tree(win).libraryobjectmenu -tearoff 0
    set sm $tree(win).libraryobjectmenu.create
    $tree(win).libraryobjectmenu add command -label [form_label_text "Load as object"] \
	-command "tree_load_library_object_node"
    $tree(win).libraryobjectmenu add command -label [form_label_text "Edit as project"] \
	-command "tree_edit_library_object"
    
    set tree(detail) 0
}

proc tree_create_types_menu {sm how} {
    global object_type_list type_name
    
    menu $sm -tearoff 0
    
    foreach type [lsort $object_type_list] {
	if {$type == "domain"} continue
	set tn $type
	if [info exists type_name($tn)] { set tn $type_name($tn) }
	switch $how {
	    inpart {
		# update_mtype $type; 
		set cmd "part_switch_model current 1; edit_new $type"
	    }
	    notinpart {
		# update_mtype $type; 
		set cmd "part_switch_model top 1; edit_new $type"
	    }
	    changetype {
		set cmd "set tree(no_events) 1; after idle \"unset tree(no_events)\; change_object_type current_sel $type\""
	    }
	}
	$sm add command -label [string totitle $tn] -command $cmd
    }
}

proc tree_build {} {
    global tree nonboldfont object_type_title tree_has_libraries
    global config_options_in_one_panel expression_no_trials_form
    global is_iceboard is_airpak

    if $is_iceboard {
	set stuff [tree_build_stuff_iceboard]
    } elseif $is_airpak {
	set stuff [tree_build_stuff_airpak]
    } else {
	set stuff [tree_build_stuff]
    }
    
    foreach {p n t c bub var ico} $stuff {
	if {($n == "lib_path") && ![info exists tree_has_libraries]} continue
	if {$var != ""} {
	    global $var
	    if ![info exists $var] continue
	}
	if {$c == ""} { set data "" } else { set data [list command_node $c] }
	if {$ico == ""} { set ico $n }
	if ![$tree(win) exists $n] {
	    $tree(win) insert end $p $n -text [form_label_text $t] -open 0 \
		-font $nonboldfont -image [tree_get_image $ico] -data $data
	}
	if {$bub != ""} { set tree(bubble,$n) $bub }
    }
    
    # -------------------------
    
    if {[info exists tree_has_libraries] && ![$tree(win) exists libraries]} {
	$tree(win) insert end root libraries -text [form_label_text Libraries]\
	    -open 0 -font $nonboldfont -image [tree_get_image libraries] \
	    -data libraries_node
	tree_make_library_subtree
    }
    
    if ![$tree(win) exists groups] {
	$tree(win) insert end root groups -text [form_label_text Groups] \
	    -open 0 -font $nonboldfont \
	    -image [tree_get_image group] -data group_container_node
    }
    
    if {[info command fpp_interface] != ""} {
    
	if ![$tree(win) exists post] {
	    $tree(win) insert end root post -text [form_label_text Post-processing]\
		-open 0 -font $nonboldfont -image [tree_get_image post] \
		-data post_container_node
	}
	
	if {![$tree(win) exists named_point_container] && !$is_iceboard} {
	    $tree(win) insert end root named_point_container \
		-text [form_label_text "Points"] -open 0 \
		-font $nonboldfont -image [tree_get_image bw_folder] \
		-data named_point_container_node
	}
    }
    
    if ![$tree(win) exists trash] {
	$tree(win) insert end root trash -text [form_label_text "Trash"] \
	    -font $nonboldfont -image [tree_get_image trash] -data trash_node
    }
    if ![$tree(win) exists inactive] {
	$tree(win) insert end root inactive -text [form_label_text "Inactive"] \
	    -font $nonboldfont -image [tree_get_image inactive] -data inactive_node
    }
    
    # -------------------------
    
    if ![$tree(win) exists model] {
	$tree(win) insert end root model -text [form_label_text Model] \
	    -open 1 -font $nonboldfont \
	    -image [tree_get_image model] -data model_node
    }
    if {$tree(showfull) && $tree(detail)} {
	tree_make_type_subtree model
    }
}

proc tree_build_stuff {} {
    global expression_no_trials_form
    
    set stuff {
	root def "Problem setup" "" {} "" bw_folder
    }
    if {[info command fpp_interface] != ""} {
	set stuff [concat $stuff {
	    def problem "Basic parameters" file_problem {
		Definition of basic problem
		parameters such as transient,
		etc
	    } "" ""
	}]
    }
    set stuff [concat $stuff {
	def title Title/notes file_notes {} "" ""
    }]
    if 0 {
	# This is now in the toolbar
	if [info exists expression_no_trials_form] {
	    lappend stuff def parameters Parameters expression_edit_values_and_trials {} "" ""
	} else {
	    lappend stuff def parameters "Parameters and trials" expression_edit_values_and_trials {} "" ""
	    lappend stuff def parameters "Optimization and trials" optimizer_setup_and_run {} "" ""
	}
    }
    set stuff [concat $stuff {
	def local_coords "Local coords" model_local_coords {} want_local_coord_systems ""
	root solve "Solution settings" {} {} want_icepak_tree_stuff bw_folder
    }]
    set stuff [concat $stuff {
	solve solve_setup "Basic settings" solve_setup_uns {} want_icepak_tree_stuff ""
	solve solve_execution "Parallel settings" solve_parallel_set {} want_icepak_tree_stuff ""
	solve solve_defaults "Advanced settings" uns_solve_advanced {} want_icepak_tree_stuff ""
    }]
    
    return $stuff
}

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

proc tree_add_object_to_group {group obj resort} {
    global tree nonboldfont object_type_title
    
    if ![info exists tree] return
    
    if ![$tree(win) exists $group] {
	$tree(win) insert end groups $group -text [$group getval name] \
	    -open 0 -font $nonboldfont -image [tree_get_image group] \
	    -data [list group_node $group]
#	$tree(win) opentree groups
    }
    
    set node $group-$obj
    if ![$tree(win) exists $node] {
	set obtype [$obj getval obtype]
	set genus [$obj getval current_genus ""]
	set col [tree_what_color $obj]
	if {[$obj getval obtype] == "domain"} {
	    set name [form_label_text $object_type_title(domain)]
	} else {
	    set name [$obj getval name]
	}
	    
	$tree(win) insert end $group $group-$obj -text $name \
	    -open 0 -fill $col -font $nonboldfont \
	    -image [tree_get_image $obtype $genus] -data "object_node $obj in_group"
	if $resort {
	    tree_sort_children $group
	}
    }
}

proc tree_what_color {obj} {
    global type_visible graph_color
    
    set obtype [$obj getval obtype]
    if [$obj si_value active] {
	if {($obtype == "part") && [$obj getval mesh_separate]} {
	    set col $graph_color(part_sep)
	} elseif {(![info exists type_visible($obtype)] || \
		 $type_visible($obtype)) && \
		([$obj getval obj_shading ""] != "Invisible")} {
	    set col black
	} else {
	    set col pink
	}
    } else { 
	set col gray
    }
    return $col
}

proc tree_remove_object_from_group {group obj} {
    global tree
    if ![info exists tree] return

    if [$tree(win) exists $group-$obj] {
	$tree(win) delete $group-$obj
    }
}

proc tree_remove_object_from_group_without_selection {group obj} {
    global tree
    
    if ![info exists tree] return
    if [$tree(win) exists $group-$obj] {
	$tree(win) delete_without_selection $group-$obj
    }
}

proc tree_rename_group {group newname} {
    tree_rename_object $group $newname
}

proc tree_delete_group {group} {
    global tree
    if ![info exists tree] return
    $tree(win) delete $group
}

proc tree_create_group {group objs} {
    global tree nonboldfont
    if ![info exists tree] return
    
    $tree(win) insert end groups $group -text [$group getval name] \
	-open 0 -font $nonboldfont -image [tree_get_image group] \
	-data [list group_node $group]
    
    foreach obj $objs {
	tree_add_object_to_group $group $obj 0
    }
    if {$objs != ""} {
	tree_sort_children $group
    }
    tree_sort_children groups
}

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

proc tree_get_image {name1 {name2 ""}} {
    global tree tree_icon_prefix tree_icon_prefix2
    
    if !$tree(showicons) { return "" }
    
    if {$name2 != ""} {
	set names [list ${name1}-$name2 $name1]
    } else {
	set names [list $name1]
    }
    
    foreach name $names {
	if ![info exists tree(image-$name)] {
	    set fname $name
	    if [info exists tree(icon_file,$name)] {
		set fname $tree(icon_file,$name)
	    }
	    # Just try a whole bunch of possible names.
	    foreach vers {tree_ ""} {
		set file $tree_icon_prefix$vers$fname
		set file2 $tree_icon_prefix2$vers$fname
		set file3 [file dirname $tree_icon_prefix]/$vers$fname
		if [file exists $file.gif] {
		    set tree(image-$name) [image create photo -file $file.gif]
		} elseif [file exists $file.xbm] {
		    set tree(image-$name) [image create bitmap -file $file.xbm \
					       -foreground black -background ""]
		} elseif [file exists $file2.gif] {
		    set tree(image-$name) [image create photo -file $file2.gif]
		} elseif [file exists $file2.xbm] {
		    set tree(image-$name) [image create bitmap -file $file2.xbm \
					       -foreground black -background ""]
		} elseif [file exists $file3.gif] {
		    set tree(image-$name) [image create photo -file $file3.gif]
		} elseif [file exists $file3.xbm] {
		    set tree(image-$name) [image create bitmap -file $file3.xbm \
					       -foreground black -background ""]
		}
		if [info exists tree(image-$name)] break
	    }
	}
	if [info exists tree(image-$name)] {
	    return $tree(image-$name)
	}
    }
    
    if ![info exists tree(image-unknown)] {
	set tree(image-unknown) [image create photo -file \
				     ${tree_icon_prefix}unknown.gif]
    }
    set tree(image-$name1) $tree(image-unknown)
    if {$name2 != ""} { set tree(image-$name2) $tree(image-unknown) }
    return $tree(image-$name1)
}

proc tree_list_objects {node avoid} {
    global tree
    set ret ""
    foreach ch [$tree(win) nodes $node] {
	if {[lsearch $ch $avoid] >= 0} continue
	
	set data [$tree(win) itemcget $ch -data]
	if {([lindex $data 0] == "object_node") &&
	    ([lindex $data 2] != "in_group")} {
	    lappend ret $ch
	}
	set ret [concat $ret [tree_list_objects $ch $avoid]]
    }
    return $ret
}

proc tree_make_type_subtree {node} {
    global tree object_type_list object_type_title nonboldfont domain
    
    foreach type [lsort $object_type_list] {
	if {![$tree(win) exists $node/$type] && ($type != "domain")} {
	    $tree(win) insert end $node $node/$type -font $nonboldfont \
		-text [form_label_text $object_type_title($type)] -open 0 \
		-data "type_node $type" -image [tree_get_image $type]
	}
    }
}

proc tree_make_library_subtree {{force 0}} {
    global tree library_path nonboldfont
    
    if {![info exists tree] || ![$tree(win) exists libraries]} return
    
    if {[info exists tree(prev_library_path)] && 
	($tree(prev_library_path) == $library_path) && !$force} return
    set tree(prev_library_path) $library_path
    
    foreach lib [$tree(win) nodes libraries] {
	tree_clear_subtree $lib */materials
    }
    
    foreach dir $library_path {
	set dir [library_dir $dir]
	set ni [library_name_and_info $dir]
	set name [lindex $ni 0]; set info [lindex $ni 1]
	if [lindex $ni 2] { set ro _ro } else { set ro "" }
	set libnode [tree_library_node_name $dir]
	if ![$tree(win) exists $libnode] {
	    $tree(win) insert end libraries $libnode \
		-font $nonboldfont -open 0 -data [list library_node$ro $dir] \
		-image [tree_get_image libraries]
	    set tree(node_for_mat_lib_path,$dir) $libnode
	}
	$tree(win) itemconfigure $libnode -text $name
	set ok($libnode) 1
	if {$info != ""} {
	    set tree(bubble,$libnode) $info
	}
	if {![$tree(win) exists $libnode/materials]} {
	    $tree(win) insert end $libnode \
		$libnode/materials -font $nonboldfont -text \
		[form_label_text Materials] -open 0 -data "type_node material" \
		-image [tree_get_image material]
	}
	if [$tree(win) itemcget $libnode -open] {
	    tree_fill_library $dir $libnode
	} else {
	    set tree(when_first_open,$libnode) \
		[list tree_fill_library $dir $libnode]
	}
    }
    foreach ch [$tree(win) nodes libraries] {
	if ![info exists ok($ch)] {
	    $tree(win) delete $ch
	}
    }
}

proc tree_library_node_name {dir} {
    regsub -all \\\$ $dir _ dir2
    regsub -all " " $dir2 _ dir2
    return libraries/$dir2
}

proc tree_fill_library {dir node} {
    global tree
    
    busy 1
    tree_clear_subtree $node */materials
    
    set stuff [library_list $dir]
    foreach item $stuff {
	tree_fill_library_node $node $item $dir
    }
    busy 0
}

proc tree_fill_library_node {parent item dir} {
    global tree nonboldfont

    regsub -all " " [lindex $item 1] _ fname1
    set fname $parent/$fname1
    
    switch [lindex $item 0] {
	directory {
	    # directory name stuff
	    if ![$tree(win) exists $fname] {
		$tree(win) insert end $parent $fname \
		    -font $nonboldfont -text [lindex $item 1] -open 0 \
		    -image [tree_get_image libraries]
	    }
	    foreach sub [lindex $item 2] {
		tree_fill_library_node $parent/[lindex $item 1] $sub $dir
	    }
	}
	object {
	    # object name type fullpath
	    if ![$tree(win) exists $fname] {
		$tree(win) insert end $parent $fname \
		    -font $nonboldfont -text [lindex $item 1] \
		    -image [tree_get_image [lindex $item 2]] \
		    -data [list library_object_node $dir [lindex $item 3] \
			       [lindex $item 2]]
	    }
	    set info [library_object_info $dir [lindex $item 3]]
	    if {[lindex $info 0] != ""} {
		set tree(bubble,$fname) [lindex $info 0]
	    }
	}
	default error
    }
}

proc tree_edit_library_info {} {
    global tree
    
    set node [lindex [$tree(win) selection get] 0]
    set dir [lindex [$tree(win) itemcget $node -data] 1]
    set ni [library_name_and_info $dir]
    set tree(name_tmp) [lindex $ni 0]; set tree(info_tmp) [lindex $ni 1]
    set d [form_init .library_name "Library name and info"]
    if {$d != ""} {
	form_label $d.nl Name {0 0}
	form_entry $d.n tree(name_tmp) string {0 1} 20
	form_text $d.info ""  tree(info_tmp) {1 0 -cols 2}
	form_finish +100+100
    }
    if ![form_wait .library_name] return
    
    library_set_name_and_info $dir $tree(name_tmp) $tree(info_tmp)
    $tree(win) itemconfigure $node -text $tree(name_tmp)
    set tree(bubble,$node) $tree(info_tmp)
}

proc tree_named_point_edit {} {
    global tree
    set node [lindex [$tree(win) selection get] 0]
    set obj [lindex [$tree(win) itemcget $node -data] 1]
    named_point_edit $obj
}

proc tree_named_point_delete_cmd {} {
    global tree
    foreach node [$tree(win) selection get] {
	set obj [lindex [$tree(win) itemcget $node -data] 1]
	named_point_delete $obj
    }
}

proc tree_clear_subtree {node {except ""}} {
    global tree
    if {![info exists tree] || ![$tree(win) exists $node]} return
    foreach ch [$tree(win) nodes $node] {
	if {($except != "") && [string match $except $ch]} continue
	$tree(win) delete $ch
    }
}

proc tree_where_is_object {obj par} {
    global tree
    
    set obtype [$obj getval obtype]
    set where end
    if {$obtype == "part"} {
	set where 0
	foreach n [$tree(win) nodes $par] {
	    set data [$tree(win) itemcget $n -data]
	    if {([lindex $data 0] == "object_node") &&
		([[lindex $data 1] getval obtype] != "part") &&
		([[lindex $data 1] getval obtype] != "domain")} {
		break
	    }
	    incr where
	}
    }
    return $where
}

proc tree_add_object {obj resort {node_tag object_node}} {
    global tree nonboldfont object_type_title
    
    if ![info exists tree] return
    
    if {[$obj getval obtype] == "domain"} {
	$tree(win) insert 0 model $obj \
	    -text [form_label_text $object_type_title(domain)] \
	    -data "$node_tag $obj" -font $nonboldfont \
	    -image [tree_get_image domain]
	return
    }
    set obtype [$obj getval obtype]
    set genus [$obj getval current_genus ""]
    set par [tree_find_parent $obj]
    
    set where [tree_where_is_object $obj $par]

    set col [tree_what_color $obj]
    $tree(win) insert $where $par $obj -text [$obj getval name] -open 0 \
	-data "$node_tag $obj" -fill $col -font $nonboldfont \
	-image [tree_get_image $obtype $genus]
    if $resort { tree_sort_children $par }
    
    if {$obtype == "part"} {
	if $tree(showfull) {
	    tree_make_type_subtree $obj
	}
	# *** This should be done somewhere else, maybe...
	part_make_open $obj 0
    }
    set sh [$obj getval body_shape]
    if {($sh != "") && [$sh get -selected]} {
	$tree(win) selection add $obj
    }
}

proc tree_finish_adding_objects {sibling} {
    global tree
    
    if ![info exists tree] return
    
    set par [tree_find_parent $sibling]
    tree_sort_children $par
}

proc tree_add_object_children {obj node_tag} {
    global tree
    
    if {[$obj getval obtype] != "part"} return
    
    foreach ch [$obj list_contents] {
	if [$tree(win) exists $ch] { $tree(win) delete $ch }
	tree_add_object $ch 0 $node_tag
	tree_add_object_children $ch $node_tag
    }
    tree_sort_children $obj
}

proc tree_find_parent {obj} {
    global tree nonboldfont object_type_title tree_always_detail
    global model_container_root

    if ![$obj si_value active] {
	return inactive
    }
    
    set type [$obj getval obtype]
    
    if [info exists tree_always_detail($type)] {
	set detail $tree_always_detail($type)
    } else {
	set detail $tree(detail)
    }
    
    set par1 ""
    set place end
    if {$type == "material"} {
	set lp [$obj getval mat_lib_path]
	if [info exists tree(node_for_mat_lib_path,$lp)] {
	    set par $tree(node_for_mat_lib_path,$lp)
	    set par1 $par/materials
	}
	set place 0
    }
    if {$par1 == ""} {
	set par [$obj get -model_container]
	if {$par == $model_container_root} { set par model }
	
	if {$detail == 0} { return $par }
	
	set par1 $par/$type
    }
    
    if ![$tree(win) exists $par1] {
	$tree(win) insert $place $par $par1 -font $nonboldfont -text \
	    [form_label_text $object_type_title($type)] -open 0 -data "type_node $type" \
	    -image [tree_get_image $type]
    }
    
    if {$detail == 1} { return $par1 }
    
    set par2 $par1
    set subtypes [db_subtypes $obj 1]
    foreach st $subtypes {
	if {$st == ""} break
	set tmp $par2
	regsub -all -- " " $st - st2
	set par2 $par2/$st2
	if ![$tree(win) exists $par2] {
	    $tree(win) insert end $tmp $par2 -text $st -font $nonboldfont \
		-data [list subtype_node $type $st] \
		-image [tree_get_image folder]
	}
    }
    if {$detail == 2} { return $par2 }
    
    set shapes [db_shapes $obj]
    if {$shapes == ""} { return $par2 }
    
    switch [llength $obj] {
	0 { return $par2 }
	1 {
	    set sht [[lindex $shapes 0] get -shtype]
	    if {$sht == "container"} { return $par2 }
	    set par3 $par2/$sht
	    if ![$tree(win) exists $par3] {
		$tree(win) insert end $par2 $par3 -text $sht \
		    -font $nonboldfont -data \
		    [list shapetype_node $type $subtypes $sht] \
		    -image [tree_get_image ${sht}_shape]
	    }
	    return $par3
	}
	default {
	    # This is not correct
	    set shn [[lindex $shapes 0] get -name]
	    set par3 $par2/$shn
	    if ![$tree(win) exists $par3] {
		$tree(win) insert end $par2 $par3 -text $shn \
		    -font $nonboldfont -data \
		    [list shapename_node $type $subtypes $shn] \
		    -image [tree_get_image folder]
	    }
	    
	    set sht [[lindex $shapes 0] get -shtype]
	    set par4 $par3/$sht
	    if ![$tree(win) exists $par4] {
		$tree(win) insert end $par3 $par4 -text $sht \
		    -font $nonboldfont -data \
		    [list shapetype_node $type $subtypes $shn $sht] \
		    -image [tree_get_image ${sht}_shape]
	    }
	    return $par4
	}
    }
}

# Objects closer to the bottom are higher priority.

proc tree_sort_children {par} {
    global tree job_listsort tree_always_alpha_sort object_category app_has_grid_type

    set children [$tree(win) nodes $par]
    if {$children == ""} return
    
    if [info exists object_category(grid_priority)] {
	set typelist $object_category(grid_priority)
    } else {
	set typelist $object_category(grid)
    }
    set poffset 1
    foreach tl $typelist {
	foreach t $tl {
	    set toffset($t) [expr $poffset * 10000000]
	}
	incr poffset
    }
    foreach t {material profile} {
	set toffset($t) [expr $poffset * 10000000]
	incr poffset
    }
    
    set toffset(domain) 0
    set toffset(part) 1
    set nodes1 ""; set nodes2 ""
    foreach ch $children {
	set data [$tree(win) itemcget $ch -data]
	switch [lindex $data 0] {
	    object_node {
		set obj [lindex $data 1]
		switch [$obj getval obtype] {
		    material - profile {
			lappend nodes2 $ch
		    }
		    default {
			if {[lindex $data 2] == "in_group"} {
			    lappend nodes2 $ch
			} else {
			    lappend nodes1 $ch
			}
		    }
		}
	    }
	    default {
		lappend nodes2 $ch
	    }
	}
    }
    set nodes2 [lsort -command tree_compare_children_nonobject $nodes2]
    if {$nodes1 != ""} {
	set how_sort $job_listsort
	set obj1 [lindex [$tree(win) itemcget [lindex $nodes1 0] -data] 1]
	if [info exists tree_always_alpha_sort([$obj1 getval obtype])] {
	    set how_sort alpha
	}
	switch $how_sort {
	    alpha {
		set nodes1 [lsort -command tree_compare_children_object_alpha $nodes1]
	    }
	    priority {
		foreach n $nodes1 {
		    set obj [lindex [$tree(win) itemcget $n -data] 1]
		    set obtype [$obj getval obtype]
		    if [info exists app_has_grid_type($obtype)] {
			set obtype [app_grid_type_$obtype $obj]
		    }
		    set pri [expr + [$obj getval creation_order] + $toffset($obtype)]
		    lappend at_pri($pri) $n
		}
		set nodes1 ""
		foreach p [lsort -integer [array names at_pri]] {
		    eval lappend nodes1 $at_pri($p)
		}
	    }
	    creation_order {
		foreach n $nodes1 {
		    set obj [lindex [$tree(win) itemcget $n -data] 1]
		    set pri [$obj getval creation_order]
		    lappend at_pri($pri) $n
		}
		set nodes1 ""
		foreach p [lsort -integer [array names at_pri]] {
		    eval lappend nodes1 $at_pri($p)
		}
	    }
	}
    }
    $tree(win) reorder $par [concat $nodes2 $nodes1]
}

proc tree_compare_children_nonobject {node1 node2} {
    global tree type_name

    set t1 [$tree(win) itemcget $node1 -text]
    set t2 [$tree(win) itemcget $node2 -text]
    set dn [string totitle $type_name(domain)]

    if {$t1 == $dn} { return -1 }
    if {$t2 == $dn} { return 1 }
    return [string compare $t1 $t2]
}

proc tree_compare_children_object_alpha {node1 node2} {
    global tree type_name
    
    set obj1 [lindex [$tree(win) itemcget $node1 -data] 1]
    set obj2 [lindex [$tree(win) itemcget $node2 -data] 1]
    
    return [alpha_compare_names [$obj1 getval name] \
		[$obj2 getval name]]
}

proc tree_sort_parent {obj} {
    global model_container_root
    set par [$obj get -model_container]
    if {$par == $model_container_root} { set par model }
    tree_sort_children $par
}

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

proc tree_reposition_one_object {obj} {
    global tree
    
    set par [$tree(win) parent $obj]
    set cre [$obj getval creation_order]
    set sibs [$tree(win) nodes $par]
    set n 0
    foreach s $sibs {
	if {([lindex [$tree(win) itemcget $s -data] 0] == "object_node") &&
	    ([$s getval creation_order] > $cre)} {
	    set pos $n
	    break
	}
	incr n
    }
    if ![info exists pos] { set pos end }
    $tree(win) move $par $obj $pos
}

proc tree_sort_all {} { 
    global batch_mode
    if !$batch_mode {
	tree_sort_below model 
    }
}

proc tree_sort_below {node {top_call 1}} {
    global tree batch_mode
    if !$batch_mode { 
	if $top_call {
	    # This is a HACK - it's really slow to determine
	    # whether plates are inside openings or not, therefore
	    # we do this pre-processing step to assemble the valid
	    # openings so the check goes faster.
	    if {[info commands app_initialize_grid_type_hack] != ""} {
		app_initialize_grid_type_hack
	    }
	}
	if ![$tree(win) exists $node] return
	tree_sort_children $node
	foreach ch [$tree(win) nodes $node] {
	    tree_sort_below $ch 0
	}
    }
}

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

proc tree_rename_object {obj newname {prefix ""}} {
    global tree group_container
    
    if ![info exists tree] return
    $tree(win) itemconfigure ${prefix}${obj} -text $newname
    
    if {$prefix != ""} {
	return
    }
    foreach g [$obj getval groups] {
	set node $group_container($g)-$obj
	if [$tree(win) exists $node] {
	    $tree(win) itemconfigure $node -text $newname
	}
    }
    tree_sort_children [$tree(win) parent $obj]
}

proc tree_configure_object {obj} {
    global tree
    if ![info exists tree] return
    if [$tree(win) exists $obj] {
	set col [tree_what_color $obj]
	$tree(win) itemconfigure $obj -fill $col
    }
}

proc tree_changeactive_object {obj} {
    global tree group_container
    
    if ![info exists tree] return
    if {[info command $obj] == ""} return ;# avoid some timing related glitches

    set col [tree_what_color $obj]
    if ![$obj si_value active] {
	set par inactive
	set where end
    } else {
	set par [tree_find_parent $obj]
	set where [tree_where_is_object $obj $par]
    }
    
    $tree(win) move $par $obj $where
    tree_sort_children $par
    $tree(win) itemconfigure $obj -fill $col
    foreach g [$obj getval groups] {
	$tree(win) itemconfigure $group_container($g)-$obj -fill $col
    }
}

proc tree_changevisible_object {obj} {
    global tree group_container
    
    if ![info exists tree] return
    if {[info command $obj] == ""} return ;# avoid some timing related glitches

    set col [tree_what_color $obj]
    $tree(win) itemconfigure $obj -fill $col
    foreach g [$obj getval groups] {
	$tree(win) itemconfigure $group_container($g)-$obj -fill $col
    }
}

# what can be subtype or shape

proc tree_changepos_object {obj what} {
    global tree
    
    if ![info exists tree] return
    if {$tree(detail) < 2} return
    if {($tree(detail) == 2) && ($what == "shape")} return
    
    $tree(win) delete $obj
    tree_add_object $obj 1
}

proc tree_remove_object {obj} {
    global tree
    
    if ![info exists tree] return
    $tree(win) delete $obj
}

proc tree_select_object {obj} {
    global tree
    
    if ![info exists tree] return
    if ![$tree(win) exists $obj] return
    if $tree(disabled) return
    
    model_set_current $obj
}

proc tree_reparent_objects {objs} {
    global tree nonboldfont
    
    if ![info exists tree] return
    foreach obj $objs {
	set opar [$tree(win) parent $obj]
	set par [tree_find_parent $obj]
	set where [tree_where_is_object $obj $par]
	$tree(win) move $par $obj $where
	set has_par($par) 1
	tree_prune_material_subtrees $opar
    }
    foreach par [array names has_par] { tree_sort_children $par }
}

proc tree_prune_material_subtrees {opar} {
    global tree
    
    while 1 {
	if {[string match "subtype_node material*" \
		 [$tree(win) itemcget $opar -data]] && \
		![llength [$tree(win) nodes $opar]]} {
	    set nopar [$tree(win) parent $opar]
	    $tree(win) delete $opar
	    set opar $nopar
	} else {
	    return
	}
    }
}

proc tree_highlight_object {obj} {
    global tree model_container_root
    
    if {$obj == ""} {
	$tree(win) selection clear
	return
    }
    
    if ![$tree(win) exists $obj] {
	puts "ERROR: $obj is not in the tree"
	return
    }
    
    # Maybe we are already in this object, inside a group.  If so stay there.
    foreach nobj [$tree(win) selection get] {
	set now [$tree(win) itemcget $nobj -data]
	if {([lindex $now 0] == "object_node") && ([lindex $now 1] == $obj)} {
	    return
	}
    }
    
    set pnode [$tree(win) parent $obj]
    if {$pnode == $model_container_root} { set pnode model }
    set tree(dont_handle_select) 1 ;# this does too much other stuff
    $tree(win) selection set $obj
    unset tree(dont_handle_select)
    tree_make_open $pnode
    $tree(win) see $obj
}

proc tree_disable_updates {dis} {
    global tree
    set tree(disabled) $dis
}

proc tree_make_open {obj} {
    global tree
    for {set n $obj} {($n != "root") && ($n != "")} \
	{set n [$tree(win) parent $n]} {
	    $tree(win) itemconfigure $n -open 1
	    tree_open_close_node 1 $n
	}
}

proc tree_hit_return {} {
    global tree
    set node [$tree(win) selection get]
    if {$node == ""} return
    tree_single_click $node
    tree_double_click $node
}

proc tree_make_objects_selected {nodes is_sel} {
    global tree shading_type
    
    foreach node $nodes {
	set data [$tree(win) itemcget $node -data]
	if {[lindex $data 0] == "object_node"} {
	    set obj [lindex $data 1]
	    foreach sh [db_shapes $obj] {
		$sh configure -selected $is_sel
	    }
	}
    }
}

proc tree_single_click {node} {
    global tree tdv_default

    if [info exists tree(no_events)] return
    
    set data [$tree(win) itemcget $node -data]

    coll_set_current group ""
    
    switch [lindex $data 0] {
        type_node {
        }
        object_node {
            set obj [lindex $data 1]
	    #set oldsel [$tree(win) selection get]
	    if [object_in_part $obj] {
		part_switch_model [$obj get -model_container] 1
	    } else {
		part_switch_model top 1
	    }
##           update_mtype [$obj getval obtype]
	    
	    # If we do this here then we can be sure it will select the
	    # right one in a group.
	    $tree(win) selection set $node
	    
            #tree_select_object $obj
	    #tree_make_objects_selected $oldsel 0
        }
        group_node {
	    set obj [lindex $data 1]
	    coll_set_current group $obj
	    $tree(win) selection set $obj
	    #tree_make_open $obj
	    #$tree(win) see $obj
	}
	not_yet_used__library_object_node {
	    set dir [lindex $data 1]
	    set file [lindex $data 2]
	    set info [library_object_info $dir $file]
	    set pict [lindex $info 2]
	    # .....
	}
	post_container_node {
	    post_maybe_reload
	}
	post_object_node {
	    set obj [lindex $data 1]
	    set_current_post_object $obj 1
	}
	not_used_libraries_node {
	    eval $tree(win) selection set [$tree(win) nodes $node]
	}
	library_node - library_node_ro - command_node - named_point_node -
	library_object_node - model_node - group_container_node -
	trash_object_node - trash_node - inactive_node - libraries_node -
	named_point_container_node {
	    $tree(win) selection set $node
	}
    }
}

proc tree_double_click {node} {
    # If we do this right away then the double click function could come right
    # in the middle of handling the single click and then we get all messed
    # up.
    after idle "tree_double_click_doit $node"
}

proc tree_double_click_doit {node} {
    global tree tdv_default

    if [info exists tree(no_events)] return
    
    edit_modify_params
    
    if ![$tree(win) exists $node] return
    
    set data [$tree(win) itemcget $node -data]
    
    switch [lindex $data 0] {
        type_node {
	    set type [lindex $data 1]
#	    update_mtype $type
	    edit_new $type
        }
	subtype_node - shapename_node - shapetype_node {
# Disable this for now
# *** Here we need to set the appropriate variables
#	    set type [lindex $data 1]
#	    update_mtype $type
#	    edit_new $type
	}
        object_node {
            set obj [lindex $data 1]
#            update_mtype [$obj getval obtype]
            tree_select_object $obj
	    edit_current_object
        }
        group_node {
	    coll_edit_parameters [lindex $data 1]
        }
        group_container_node {
	    #coll_edit group
	    coll_create group __ask__
        }
	library_object_node {
	    tree_load_library_object_node $node
	}
	post_object_node {
	    set obj [lindex $data 1]
	    set_current_post_object $obj
	    post_edit
	}
	named_point_node {
	    set obj [lindex $data 1]
	    named_point_edit $obj
	}
	named_point_container_node {
	    named_point_edit
	}
	command_node {
	    eval [lindex $data 1]
	}
	trash_object_node {
	    trash_remove [lindex $data 1] "" 0
	}
    }
}

proc tree_load_library_object_node {{nodes ""}} {
    global tree
    
    if {$nodes == ""} {
	set nodes [$tree(win) selection get]
    }
    
    foreach node $nodes {
	set data [$tree(win) itemcget $node -data]
	if {[lindex $data 0] != "library_object_node"} continue
	set dir [lindex $data 1]
	set file [lindex $data 2]
	library_load_object $dir $file [part_get_root] [lindex $data 3]
    }
}

proc tree_edit_library_object {} {
    global tree
    
    set node [lindex [$tree(win) selection get] 0]
    set data [$tree(win) itemcget $node -data]
    set dir [lindex $data 1]
    set file [lindex $data 2]
    job_load [file dirname $file] ""
}

proc tree_shift_click {node} {
    global tree

    if [info exists tree(no_events)] return
    
    set data [$tree(win) itemcget $node -data]
    switch [lindex $data 0] {
	type_node {
	}
	object_node - library_node - library_node_ro -
	library_object_node - group_node -
	named_point_node - post_object_node - trash_object_node {
	    set sel [$tree(win) selection get]
	    if {$sel == ""} {
		tree_single_click $node
	    } else {
		set last [lindex $sel end]
		$tree(win) selection add $node
		set p1 [$tree(win) parent $last]
		set p2 [$tree(win) parent $node]
		if {$p1 == $p2} {
		    set i1 [$tree(win) index $last]
		    set i2 [$tree(win) index $node]
		    if {$i2 < $i1} { set i3 $i1; set i1 $i2; set i2 $i3 }
		    set nodes [$tree(win) nodes $p1 $i1 $i2]
		    eval $tree(win) selection add $nodes
		    #tree_make_objects_selected $nodes 1
		}
	    }
	}
    }
    grid_update_images 0
}

proc tree_control_click {node} {
    global tree

    if [info exists tree(no_events)] return

    set data [$tree(win) itemcget $node -data]
    switch [lindex $data 0] {
	type_node {
	}
	object_node - library_node - library_node_ro -
	library_object_node - group_node -
	named_point_node - post_object_node - trash_object_node {
	    set sel [$tree(win) selection get]
	    if {$sel == ""} {
		tree_single_click $node
	    } elseif {[lsearch $sel $node] < 0} {
		$tree(win) selection add $node
		#tree_make_objects_selected $node 1
	    } else {
		$tree(win) selection remove $node
		#tree_make_objects_selected $node 0
	    }
	}
    }
    grid_update_images 0
}

proc tree_change_selection {objects add} {
    global tree
    
    switch $add {
	0 { eval $tree(win) selection remove $objects }
	1 { eval $tree(win) selection add $objects }
	2 {
	    eval $tree(win) selection set $objects
	    if {$objects != ""} {
		set edit_current_active [[lindex $objects 0] si_value active]
	    }
	}
    }
}

proc tree_rightmenu {x y node} {
    global tree type_visible current_object_sel

    if [info exists tree(no_events)] return
    
    set current_object_sel ""
    foreach nn [$tree(win) selection get] {
	set data [$tree(win) itemcget $nn -data]
	if {[lindex $data 0] == "object_node"} {
	    lappend current_object_sel [lindex $data 1]
	}
    }
    
    if {[lsearch [$tree(win) selection get] $node] < 0} {
	tree_single_click $node
    }
    if {[$tree(win) selection get] == ""} return
    
    set data [$tree(win) itemcget $node -data]
    if {[$tree(win) parent $node] == "root"} {
	set tree(object_is_separate) 1
    } else {
	set tree(object_is_separate) 0
    }
    
    switch [lindex $data 0] {
	type_node {
	    set type [lindex $data 1]
#	    update_mtype $type
	    set tree(this_type_visible) $type_visible($type)
	    set tree(this_type) $type
	    set whichm typemenu
	}
	subtype_node - shapename_node - shapetype_node {
	    set type [lindex $data 1]
#	    update_mtype $type
	    set whichm subtypemenu
	}
	object_node {
	    if {[$tree(win) selection get] == ""} {
		tree_single_click $node
	    }
	    set obj [lindex $data 1]
	    set type [$obj getval obtype]
	    set typen object
	    if [winfo exists $tree(win).${type}_objectmenu] {
		set typen ${type}_object
	    }
	    if {$type == "material"} {
		set mp [$obj getval mat_lib_path]
		if {$mp == ""} {
		    set typen material_model_object
		}
	    }
	    if {[lindex $data 2] == "in_group"} {
		set whichm ${typen}ingroup_menu
	    } else {
		set whichm ${typen}menu
	    }
	}
	model_node {
	    set whichm modelmenu
	}
	trash_node {
	    set whichm trashmenu
	}
	trash_object_node {
	    set whichm trashobjectmenu
	}
	post_object_node {
	    set whichm postobjectmenu
	}
	named_point_node {
	    set whichm monitorpointmenu
	}
	named_point_container_node {
	    set whichm monitorcontainermenu
	}
	inactive_node {
	    set whichm inactivecontainermenu
	}
	group_container_node {
	    set whichm grouptypemenu
	}
	group_node {
	    coll_set_current group [lindex $data 1]
	    set whichm groupmenu
	}
	libraries_node {
	    if {[$tree(win).librariesmenu index end] == 0} {
		make_browser_menu $tree(win).librariesmenu
	    }
	    set whichm librariesmenu
	}
	library_node - library_node_ro {
	    if {[$tree(win).librarymenu index end] == 0} {
		make_browser_menu $tree(win).librarymenu
	    }
	    set whichm librarymenu
	}
	library_object_node {
	    set whichm libraryobjectmenu
	}
	default return
    }
    if [winfo exists $tree(win).$whichm] {
	tk_popup $tree(win).$whichm $x $y
    }
}

proc tree_part_is_separately_viewed {obj} {
    return [expr {[$tree(win) parent $obj] == "root"}]
}

proc tree_search_library {func} {
    global tree
    
    set nodes [$tree(win) selection get]
    if {$nodes == "libraries"} {
	set nodes [$tree(win) nodes libraries]
    }
    
    set dirs ""
    foreach node $nodes {
	set data [$tree(win) itemcget $node -data]
	if {([lindex $data 0] == "library_node") ||
	    ([lindex $data 0] == "library_node_ro")} {
	    lappend dirs [lindex $data 1]
	}
    }
    $func $dirs
}

proc tree_remove_from_group_action {} {
    global tree
    
    foreach node [$tree(win) selection get] {
	set data [$tree(win) itemcget $node -data]
	set pdata [$tree(win) itemcget [$tree(win) parent $node] \
		       -data]
	coll_remove_object [lindex $pdata 1] [lindex $data 1]
    }
}

proc tree_delete_selected {} {
    global tree group
    
    set sel [$tree(win) selection get]
    
    # If we don't do this then deleting every object one by one is very slow
    # if you have, say, 1000 objects
    $tree(win) selection set ""

    foreach node $sel {
	set data [$tree(win) itemcget $node -data]
	switch [lindex $data 0] {
	    group_node {
		coll_delete group [lindex $data 1]
		$tree(win) delete $node
	    }
	    object_node {
		form_cancel_class model
		set opar [$tree(win) parent $node]
		trash_add [lindex $data 1]
		tree_prune_material_subtrees $opar
	    }
	    post_object_node {
		post_delete [lindex $data 1]
	    }
	    named_point_node {
		named_point_delete [lindex $data 1]
	    }
	}
    }
}

proc tree_part_from_selected {} {
    global tree 

    set part [edit_new part ""]
    set objects [tree_selected_objects 0]
    part_move_object_into $part $objects 1
    #objects_to_part $objects $part
    $tree(win) selection set $part
}

proc tree_selected_objects {flatten} {
    global tree
    set objects ""
    foreach node [$tree(win) selection get] {
	set dat [$tree(win) itemcget $node -data]
	if {[lindex $dat 0] == "object_node"} {
	    if {$flatten && ([[lindex $dat 1] getval obtype] == "part")} {
		set objects [concat $objects [part_list_all [lindex $dat 1] 0]]
	    } else {
		lappend objects [lindex $dat 1]
	    }
	} elseif {[lindex $dat 0] == "group_node"} {
	    set objects [concat $objects [coll_contents group [[lindex $dat 1] getval name] 1]]
	}
    }
    return $objects
}

proc tree_group_from_selected {} {
    set ngroup [coll_create group __ask__]
    if {$ngroup == ""} return
    
    set objects [tree_selected_objects 0]
    coll_add_object $ngroup $objects
}

proc tree_object_compute {what} {
    set objects [tree_selected_objects 1]
    set tot 0
    set na 0
    set nl 0
    foreach obj $objects {
	if ![$obj si_value active] { incr na; continue }
	foreach sh [db_shapes $obj] {
	    set tot [expr $tot + [$sh get_$what]]
	}
	incr nl
    }
    if $na { set namess " (active objects only)" } else { set namess "" }
    mess "$nl object[expr {($nl == 1) ? "" : "s"}], total $what = $tot$namess\n"
}

proc tree_object_create_mon_pt {} {
    global tree
    
    foreach obj [tree_selected_objects 1] {
	named_point_create $obj
    }
    $tree(win) opentree named_point_container
}

proc tree_object_edit_mesh_params {} {
    foreach obj [tree_selected_objects 0] {
	grid_edit_perobject_one object $obj
    }
}

proc tree_object_post_face {} {
    global post_current tree
    
    set objs [tree_selected_objects 1]
    foreach obj $objs {
	post_create objsurface 0 [list object_names \
				      [list object [$obj getval name]] \
				      contour_draw 1]
	$tree(win) selection set $post_current
    }
    if {[llength $objs] == 1} {
	post_edit
    }
}

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

# Detail is:
# 0 Name
# 1 Type / name
# 2 Type / subtype / name
# 3 Type / subtype / geometry / name
# 4 Type / subtype / geometry / name / spreadsheet

proc tree_detail {{dir 0}} {
    global tree group_container
    
    busy 1
    incr tree(detail) $dir
    if $dir {
	if {$tree(detail) < 0} { set tree(detail) 0 }
	if {$tree(detail) > 3} { set tree(detail) 3 }
	if {$tree(detail) == 0} {
	    $tree(less_but) configure -state disabled -fg gray
	} else {
	    $tree(less_but) configure -state normal -fg black
	}
	if {$tree(detail) == 3} {
	    $tree(more_but) configure -state disabled -fg gray
	} else {
	    $tree(more_but) configure -state normal -fg black
	}
    }
    
    if 0 {
	if {$tree(detail) == 4} {
	    $tree(frame) configure -width $tree(largewidth)
	} else {
	    $tree(frame) configure -width $tree(smallwidth)
	}
    }
    
    set objects ""
    foreach obj [tree_list_objects model model/material] {
	lappend objects $obj [$tree(win) visible $obj]
    }
    
    # This is to avoid rebuilding the materials subtree which can be big
    # and doesn't change in any case
    #set chlist [$tree(win) nodes root]
    set chlist model
    if [$tree(win) exists model/material] {
	$tree(win) move root model/material end
    }
    set m_o [$tree(win) itemcget model -open]
    $tree(win) delete $chlist
    #$tree(win) configure -redraw 0
    tree_build
    foreach {obj vis} $objects {
	tree_add_object $obj 0
	if $vis { tree_make_open $obj }
	foreach g [$obj getval groups] {
	    tree_add_object_to_group $group_container($g) $obj 0
	}
    }
    if [$tree(win) exists model/material] {
	$tree(win) move model model/material end
    }
    tree_sort_below model
    $tree(win) itemconfigure model -open $m_o
    busy 0
    # $tree(win) configure -redraw 1
    # tree_make_spreadsheets root [expr $tree(detail) == 4]
}

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

proc tree_highlight {on node} {
    global tree normalfont nonboldfont boldfont
    
    # It could be that we just deleted this node
    if [$tree(win) exists $node] {
	if [info exists tree(bubble,$node)] {
	    if $on {
		bubble_action enter $tree(win) $tree(bubble,$node)
	    } else {
		bubble_action leave $tree(win)
	    }
	}
	if 0 { this is distracting
	    if $on {
		$tree(win) itemconfigure $node -font $boldfont
	    } else {
		$tree(win) itemconfigure $node -font $nonboldfont
	    }
	}
    }
}

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

proc tree_tearoff_object {{nodes ""}} {
    global tree
    
    if {$nodes == ""} {
	set nodes [$tree(win) selection get]
    }
    foreach node $nodes {
	set obj [lindex [$tree(win) itemcget $node -data] 1]
	set sh [$obj getval body_shape]
	if {[$tree(win) parent $node] == "root"} {
	    $sh configure -editing_separately 0
	    set par [tree_find_parent $obj]
	    $tree(win) move $par $node end
	    tree_sort_children $par
	    $tree(win) itemconfigure model -open 1
	    tree_open_close_node 1 model
	} else {
	    $tree(win) move root $node end
	    $sh configure -editing_separately 1
	    $tree(win) itemconfigure model -open 0
	    tree_open_close_node 0 model
	    $tree(win) opentree $node
	}
    }
}

proc tree_opentree_current {open} {
    global tree
    
    foreach node [$tree(win) selection get] {
	if $open {
	    $tree(win) opentree $node
	} else {
	    $tree(win) closetree $node
	}
    }
}

proc tree_rename {} {
    global tree model_data
    
    foreach node [$tree(win) selection get] {
	if {[lindex [$tree(win) itemcget $node -data] 0] != "object_node"} continue
	set obj [lindex [$tree(win) itemcget $node -data] 1]
	
	if {[$obj getval no_geometry_modify 0] || [$obj getval no_name_modify 0]} {
	    mess "Can't modify the name of this object\n" red
	    return
	}
	
	set nname [question "Rename object" [$obj getval name]]
	if {$nname != ""} {
	    set model_data(name) $nname
	    edit_modify_params
	}
    }
}

proc tree_toggle_current_active {{reverse 0}} {
    global tree domain post_current_active
    
    foreach node [$tree(win) selection get] {
	set data [$tree(win) itemcget $node -data]
	set obj [lindex [$tree(win) itemcget $node -data] 1]
	
	switch [lindex $data 0] {
	    object_node {
		set obj [lindex $data 1]
		if {$obj != $domain} {
		    edit_toggle_current_active $obj $reverse
		}
	    }
	    post_object_node {
		if $reverse {
		    set post_current_active [expr !$post_current_active]
		}
		post_set_active
	    }
	}	
    }
}

proc tree_toggle_current_visible {{reverse 0}} {
    global tree
    foreach node [$tree(win) selection get] {
	set obj [lindex [$tree(win) itemcget $node -data] 1]
	edit_toggle_current_visible $obj $reverse
    }
}

proc tree_part_is_open {part} {
    global tree model_container_root
    
    if ![info exists tree] { return 1 }
    if {$part == $model_container_root} {
	return [$tree(win) itemcget model -open]
    } else {
	return [$tree(win) itemcget $part -open]
    }
}

proc tree_is_selected {obj} {
    global tree
    if ![info exists tree] { return "" }
    foreach s [$tree(win) selection get] {
	if {[lindex [$tree(win) itemcget $s -data] 1] == $obj} {
	    return 1
	}
    }
    return 0
}

proc tree_spreadsheet {} {
    global tree
    
    user_error "Sorry, not yet implemented"
    
    set node $tree(right_selected)
    
    set objects [tree_list_objects $node ""]
    
    set data [$tree(win) itemcget $node -data]
    switch [lindex $data 0] {
	type_node {
	    set show_what basic
	}
	subtype_node - shapename_node {
	    set show_what "basic object"
	}
	shapetype_node {
	    set show_what "basic object shape"
	}
    }
    
    # Create a spreadsheet with the listed objects, using the types of
    # data in show_what
    spread_edit $objects $show_what
}

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

proc tree_post_selection_add {obj} {
    global tree nonboldfont

    if [$tree(win) exists $obj] {
	$tree(win) delete $obj
    }
    
    set obtype [$obj cget -obtype]
    set name [$obj cget -name]
    
    # this is dumb
    array set names {
	objsurface object_face
	planecut plane_cut
	isosurface iso_surface
	point point_probe
    }
    if [$obj get -active] {
	set parent post
	$tree(win) opentree post
    } else {
	set parent inactive
    }
    $tree(win) insert end $parent $obj -text $name -open 0 \
	-font $nonboldfont -image [tree_get_image $names($obtype)] -data \
	[list post_object_node $obj]
    if ![$obj get -active] {
	$tree(win) itemconfigure $obj -fill gray
    }
}

proc tree_post_selection_delete {obj} {
    global tree
    if ![$tree(win) exists $obj] return
    $tree(win) delete $obj
}

proc tree_post_selection_set {obj} {
    global tree
    $tree(win) selection set $obj
    $tree(win) see $obj
}

proc tree_post_rename {obj} {
    global tree
    if ![$tree(win) exists $obj] return
    $tree(win) itemconfigure $obj -text [$obj get -name]
}

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

proc tree_trash_add {obj} {
    global tree nonboldfont
    
    if [$tree(win) exists $obj] {
	$tree(win) move trash $obj end
    } else {
	set obtype [$obj getval obtype]
	set genus [$obj getval current_genus ""]
	set name [$obj getval name]
	$tree(win) insert end trash $obj \
	    -text $name -font $nonboldfont \
	    -image [tree_get_image $obtype $genus]
    }
    
    $tree(win) itemconfigure $obj -data [list trash_object_node $obj]
}

proc tree_trash_remove {obj} {
    global tree
    
    $tree(win) delete $obj
}

proc tree_trash_remove_all {} {
    global tree
    global batch_mode
    if !$batch_mode { 
	eval $tree(win) delete [$tree(win) nodes trash]
    }
}

proc tree_trash_remove_selected {} {
    global tree
    
    foreach node [$tree(win) selection get] {
	set data [$tree(win) itemcget $node -data]
	if {[lindex $data 0] == "trash_object_node"} {
	    lappend objs [lindex $data 1]
	}
    }
    trash_remove $objs "" 0
}

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

proc tree_named_point_add {name objname {after ""}} {
    global tree nonboldfont
    
    if ![$tree(win) exists named_point_container] return ;# e.g. iceboard
    
    if {$objname != ""} {
	set obj [db_get_name $objname]
	set obtype [$obj getval obtype]
	set genus [$obj getval current_genus ""]
	set nodetext $name
	set image [tree_get_image $obtype $genus]
    } else {
	set nodetext $name
	set image [tree_get_image point_probe]
    }
    
    if {$after == ""} {
	set pos end
    } else {
	set pos [$tree(win) index named_point_$after]
    }
    set nodename named_point_$name
    foreach c {" " \t \\( \\)} {
	regsub -all $c $nodename "_" nodename
    }
    if [$tree(win) exists $nodename] return
    
    $tree(win) insert $pos named_point_container $nodename \
	-text $nodetext -font $nonboldfont -image $image \
	-data [list named_point_node $name]
}

proc unused__tree_named_point_add_xyz {name {after ""}} {
    global tree nonboldfont
    
    if ![$tree(win) exists named_point_container] return
    regsub -all " " named_point_$name "_" nodename
    if [$tree(win) exists $nodename] return
    if {$after == ""} {
	set pos end
    } else {
	set pos [$tree(win) index named_point_$after]
    }
    
    $tree(win) insert $pos named_point_container $nodename \
	-text $name -font $nonboldfont -image [tree_get_image point_probe] \
	-data [list named_point_node $name]
}

proc tree_named_point_delete {obj} {
    global tree
    
    regsub -all " " named_point_$obj "_" nodename
        
    if ![$tree(win) exists $nodename] return
    $tree(win) delete $nodename
}

proc tree_named_point_copy_move {copy} {
    global tree
    set sel [$tree(win) selection get]
    
    set names ""
    foreach s $sel {
	lappend names [lindex [$tree(win) itemcget $s -data] 1]
    }
    if {$names == ""} return
    
    named_point_copymove $copy $names
}

proc tree_named_point_rename {oldname newname} {
    global tree nonboldfont
    
    if ![info exists tree] return
    if ![$tree(win) exists named_point_container] return
    
    regsub -all " " named_point_$oldname "_" oldnode
    regsub -all " " named_point_$newname "_" newnode
    
    set im [$tree(win) itemcget $oldnode -image]
    set wh [$tree(win) index $oldnode]
    $tree(win) insert $wh named_point_container $newnode \
	-text $newname -font $nonboldfont -image $im \
	-data [list named_point_node $newname]
    $tree(win) delete $oldnode
}

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

proc tree_search_start {} {
    global tree
    set tree(startwith) ""
    if ![tree_dfs $tree(search) root 1] {
	mess "Object name \"$tree(search)\" not found\n" red
    }
}

proc tree_search_next {} {
    global tree
    set tree(startwith) [lindex [$tree(win) selection get] 0]
    if ![tree_dfs $tree(search) root 1] {
	mess "Object name \"$tree(search)\" not found below\n" red
    }
}

proc tree_search_prev {} {
    global tree
    set tree(startwith) [lindex [$tree(win) selection get] 0]
    if ![tree_dfs $tree(search) root 0] {
	mess "Object name \"$tree(search)\" not found above\n" red
    }
}

proc tree_dfs {string node forward} {
    global tree
    set children [$tree(win) nodes $node]
    if !$forward { set children [lreverse $children] }
    set string [string tolower $string]
    foreach child $children {
	set data [$tree(win) itemcget $child -data]
	#if {[lindex $data 0] == "object_node"}
	set name [string tolower [$tree(win) itemcget $child -text]]
	if {$tree(startwith) != ""} {
	    if {$child == $tree(startwith)} { set tree(startwith) "" }
	} else {
	    if [string match *$string* $name] {
		tree_see $child
		tree_single_click $child
		return 1
	    }
	}
	
	if [tree_dfs $string $child $forward] { return 1 }
    }
    return 0
}

proc tree_see {node} {
    global tree
    for {set p $node} {$p != "root"} {set p [$tree(win) parent $p]} {
	if ![$tree(win) itemcget $p -open] {
	    $tree(win) itemconfigure $p -open 1
	    tree_open_close_node 1 $p
	}
    }
    $tree(win) see $node
}

# tr changed on selected

proc tree_handle_select {tr args} {
    global tree domain current_object
    
    set selected $args
    
    if [info exists tree(prev_selected)] {
	set prev_selected $tree(prev_selected)
    } else {
	set prev_selected ""
    }
    set tree(prev_selected) $selected
    
    # This happens a lot when deleting tree nodes, etc
    if {$selected == $current_object} return
    
    # This means we were called from code that just wants to highlight
    # something in the tree and not edit stuff, etc
    if [info exists tree(dont_handle_select)] return
    
    edit_modify_params ;# just in case there is an object edit form up
    
    set_current_post_object ""
    
    foreach n $prev_selected {
	if {[lsearch $selected $n] >= 0} continue
	# this one was turned off
	set data [$tree(win) itemcget $n -data]
	switch [lindex $data 0] {
	    object_node {
		if {[info command [lindex $data 1]] == ""} {
		    mess "Internal error: the object [lindex $data 1] doesn't exist!\n" red
		    return
		}
		make_selected [lindex $data 1] "" 0
	    }
	    named_point_node {
		named_point_make_selected [lindex $data 1] 0
	    }
	}
    }
    foreach n $selected {
	if {[lsearch $prev_selected $n] >= 0} continue
	# this one was turned on
	set data [$tree(win) itemcget $n -data]
	switch [lindex $data 0] {
	    object_node {
		if {[info command [lindex $data 1]] == ""} {
		    mess "Internal error: the object [lindex $data 1] doesn't exist!\n" red
		    return
		}
		make_selected [lindex $data 1] "" 1
	    }
	    named_point_node {
		named_point_make_selected [lindex $data 1] 1
	    }
	}
    }
    
    set oneobj ""
    
    foreach n $selected {
	set data [$tree(win) itemcget $n -data]
	if {[lindex $data 0] == "object_node"} {
	    if {$oneobj == ""} {
		set oneobj [lindex $data 1]
	    } else {
		return
	    }
	}
    }
    if {$oneobj != ""} {
	model_set_current $oneobj 1
	if [edit_form_is_up] edit_current_object
    } else {
	edit_set_subform none
	form_cancel_class model
    }
}

proc tree_get_one_object_selected {} {
    global tree
    set obj ""
    foreach node [$tree(win) selection get] {
	set data [$tree(win) itemcget $node -data]
	if {[lindex $data 0] == "object_node"} {
	    if {$obj != ""} {
		user_error "You can only select one node for this operation"
		return bad
	    }
	    set obj [lindex $data 1]
	}
    }
    return $obj
}

proc tree_list_selected {} {
    global tree
    set objs ""
    foreach node [$tree(win) selection get] {
	set data [$tree(win) itemcget $node -data]
	if {[lindex $data 0] == "object_node"} {
	    lappend objs [lindex $data 1]
	}
    }
    return $objs
}

proc tree_merge_job {} {
    set obj [tree_get_one_object_selected]
    if {$obj == "bad"} return
    file_merge $obj
}

proc tree_load_part {use_cur} {
    global model_container_root tree trash_container
    
    set obj ""
    if $use_cur {
	set obj [tree_get_one_object_selected]
	if {$obj == "bad"} return
    }
    set nn [file_select_job load]
    if {$nn == ""} return
    
    set obname [file tail $nn]
    set prev [$model_container_root get_name $obname 1]
    if {($prev != "") && ($obj != $prev)} {
	set nn2 [$model_container_root new_name [file rootname $obname] 1]
	mess "Renaming part \"$obname\" to \"$nn2\" to avoid\
			name conflict with existing object\n"
	set obname $nn2
    }
    if {[$trash_container get_name $obname 1] != ""} {
	set nn2 [$trash_container new_name $obname]
	mess "Name \"$obname\" 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 obname $nn2
    }
    
    if $use_cur {
	$tree(win) itemconfigure $obj -text $obname
	$obj setval name $obname part_type external part_job $nn part_job_loaded ""
	app_clean_up_part $obj

    } else {
	set obj [edit_new part $obname 1 "" \
		     [list part_type external part_job $nn]]
	app_clean_up_part $obj
	if ![$tree(win) exists $obj] error
    }
    $obj setval part_type internal
    edit_check_outside $obj 1
}

proc tree_save_part {} {
    global model_container_root
    
    set obj [tree_get_one_object_selected]
    if {$obj == "bad"} return
    
    part_save_to_job $obj
}
