note
	description: "Tree showing the classes present in the system."
	legal: "See notice at end of class."
	status: "See notice at end of class."
	date: "$Date$"
	revision: "$Revision$"

class
	EB_CLASSES_TREE

inherit
	ES_TREE

	EB_CLUSTER_MANAGER_OBSERVER
		undefine
			default_create, is_equal, copy
		redefine
			on_class_added, on_class_removed, on_class_moved,
			on_cluster_added, on_cluster_removed, on_cluster_changed, on_cluster_moved,
			on_project_loaded, on_project_unloaded,
			refresh
		end

	EV_KEY_CONSTANTS
		export
			{NONE} all
		undefine
			default_create, is_equal, copy
		end

	EB_CONSTANTS
		export
			{NONE} all
		undefine
			default_create, is_equal, copy
		end

	SHARED_EIFFEL_PROJECT
		export
			{NONE} all
		undefine
			default_create, is_equal, copy
		end

	EB_RECYCLABLE
		undefine
			default_create, is_equal, copy
		end

	EB_SHARED_WINDOW_MANAGER
		export
			{NONE} all
		undefine
			default_create, is_equal, copy
		end

	SHARED_WORKBENCH
		undefine
			default_create, is_equal, copy
		end

	ES_SHARED_PROMPT_PROVIDER
		export
			{NONE} all
		undefine
			default_create,
			copy,
			is_equal
		end

create
	make,
	make_without_targets,
	make_with_options,
	make_for_class_selection

feature {NONE} -- Initialization

	make (a_context_menu_factory: EB_CONTEXT_MENU_FACTORY)
			-- Initialize the tree of clusters.
		do
			default_create
			context_menu_factory := a_context_menu_factory
			prepare
			manager.extend (Current)
--| FIXME XR: When clusters can be moved for real, uncomment this line.
--			drop_actions.extend (~on_cluster_drop)
			create classes_double_click_agents.make
			create cluster_double_click_agents.make
			create classes_single_click_agents.make
			create cluster_single_click_agents.make
			create expanded_clusters.make (20)
			set_minimum_height (20)
			enable_default_tree_navigation_behavior (False, False, False, True)
			has_targets := True
			is_show_classes := True
		end

	make_without_targets (a_context_menu_factory: EB_CONTEXT_MENU_FACTORY)
			-- Create a tree where targets of system are not shown.
		do
			make (a_context_menu_factory)
			has_targets := False
		end

	make_for_class_selection (a_context_menu_factory: EB_CONTEXT_MENU_FACTORY)
			-- Create a tree where only existing classes may be shown.
		do
			make (a_context_menu_factory)
			has_targets := False
			is_class_selection_only := True
		end

	make_with_options (a_context_menu_factory: EB_CONTEXT_MENU_FACTORY; a_show_targets, a_show_classes: BOOLEAN)
			-- Create a tree with options
		do
			make (a_context_menu_factory)
			has_targets := a_show_targets
			is_show_classes := a_show_classes
		ensure
			set: has_targets = a_show_targets
			set: is_show_classes = a_show_classes
		end

	prepare
			-- Create the controls and setup the layout.
		do
			set_pixmaps_size (16, 16)
		end

	build_tree
			-- Remove and replace contents of `Current'.
		local
			l_env: EV_ENVIRONMENT
			l_locked: BOOLEAN
		do
			create l_env
			if window /= Void and l_env.application.locked_window = Void then
					-- Lock update of window, so rebuilding of `Current'
					-- is hidden.			
				window.lock_update
				l_locked := True
			end

				-- Store expanded state of `Current'
			store_expanded_state

			build_tree_on_list (Current)

				-- Restore original expanded state, stored during last call to
				-- `store_expanded_state'
			restore_expanded_state

			if window /= Void and l_locked then
					-- Unlock update of window as `Current' has
					-- been rebuilt.
				window.unlock_update
			end
		end

	build_tree_on_list (a_list: EV_DYNAMIC_LIST [EV_CONTAINABLE])
			-- Build tree on `a_list'
		require
			a_list_not_void: a_list /= Void
		local
			l_target: CONF_TARGET
		do
				-- Remove all items, ready for rebuilding.
			if Eiffel_project.workbench.is_universe_ready then
				a_list.wipe_out

				l_target := Universe.target

					-- Sort clusters.
				create cluster_header.make (interface_names.l_class_tree_clusters, pixmaps.icon_pixmaps.top_level_folder_clusters_icon)
				build_group_tree (a_list, manager.clusters, cluster_header)
				cluster_header.set_pebble (create {DATA_STONE}.make
					(groups_from_sorted_clusters (manager.clusters, True), agent is_group_valid, interface_names.l_class_tree_clusters))
				if context_menu_factory /= Void then
					cluster_header.set_configurable_target_menu_mode
					cluster_header.set_configurable_target_menu_handler (agent context_menu_factory.clusters_data_menu)
				end

					-- Sort overrides.
				create override_header.make (interface_names.l_class_tree_overrides, pixmaps.icon_pixmaps.top_level_folder_overrides_icon)
				build_group_tree (a_list, manager.overrides, override_header)
				override_header.set_pebble (create {DATA_STONE}.make
					(groups_from_sorted_clusters (manager.overrides, False), agent is_group_valid, interface_names.l_class_tree_overrides))
				if context_menu_factory /= Void then
					override_header.set_configurable_target_menu_mode
					override_header.set_configurable_target_menu_handler (agent context_menu_factory.clusters_data_menu)
				end

					-- Sort libraries.
				create library_header.make (interface_names.l_class_tree_libraries, pixmaps.icon_pixmaps.top_level_folder_library_icon)
				build_group_tree (a_list, manager.libraries, library_header)
				library_header.set_pebble (create {DATA_STONE}.make
					(groups_from_sorted_clusters (manager.libraries, False), agent is_group_valid, interface_names.l_class_tree_libraries))
				if context_menu_factory /= Void then
					library_header.set_configurable_target_menu_mode
					library_header.set_configurable_target_menu_handler (agent context_menu_factory.libraries_data_menu)
				end

					-- Sort assemblies.
				create assembly_header.make (interface_names.l_class_tree_assemblies, pixmaps.icon_pixmaps.top_level_folder_references_icon)
				build_group_tree (a_list, manager.assemblies, assembly_header)
				assembly_header.set_pebble (create {DATA_STONE}.make
					(groups_from_sorted_clusters (manager.assemblies, False), agent is_group_valid, interface_names.l_class_tree_assemblies))
				if context_menu_factory /= Void then
					assembly_header.set_configurable_target_menu_mode
					assembly_header.set_configurable_target_menu_handler (agent context_menu_factory.assemblies_data_menu)
				end

					-- Targets.
				if has_targets then
					build_target_tree (a_list)
				end
			end
		end

feature -- Activation

	associate_textable_recursively (a_textable: EV_TEXT_COMPONENT; a_list: EV_DYNAMIC_LIST [EV_TREE_NODE])
			-- Associate `a_textable' with all items in `a_list'
		require
			not_void: a_textable /= Void
			not_void: a_list /= Void
		do
			from
				a_list.start
			until
				a_list.after
			loop
				if attached {EB_CLASSES_TREE_ITEM} a_list.item as l_item then
					if l_item.text.is_equal (l_item.dummy_string) then
						-- Current `a_list' contain dummy node, we set `a_textable' with it in expand actions
						if attached {EV_TREE_NODE_ACTION_SEQUENCES} a_list as l_actions then
							l_actions.expand_actions.extend_kamikaze (agent associate_textable_recursively (a_textable, a_list))
						end
					end
					if is_class_selection_only then
						if attached {EB_CLASSES_TREE_CLASS_ITEM} l_item then
								-- We only want class items to change the textable.
							l_item.set_associated_textable (a_textable)
						end
					else
						l_item.set_associated_textable (a_textable)
					end
				end

				associate_textable_recursively (a_textable, a_list.item)
				a_list.forth
			end
		end

	associate_textable_with_classes (a_textable: EV_TEXT_COMPONENT)
			-- Set `textable' to `a_textable'
		do
			textable := a_textable
		end

	associate_with_window (a_window: EB_DEVELOPMENT_WINDOW)
			-- Set `window' to `a_window'.
		do
			if window = Void then
				key_press_actions.extend (agent on_key_pushed)
			end
			window := a_window
		end

	add_double_click_action_to_classes (p: PROCEDURE [INTEGER, INTEGER, INTEGER, DOUBLE, DOUBLE, DOUBLE, INTEGER, INTEGER])
			-- Add a double click action for classes.
		do
			classes_double_click_agents.extend (p)
		end

	add_double_click_action_to_cluster (p: PROCEDURE [INTEGER, INTEGER, INTEGER, DOUBLE, DOUBLE, DOUBLE, INTEGER, INTEGER])
			-- Add a double click action for classes.
		do
			cluster_double_click_agents.extend (p)
		end

	add_single_click_action_to_classes (p: PROCEDURE [INTEGER, INTEGER, INTEGER, DOUBLE, DOUBLE, DOUBLE, INTEGER, INTEGER])
			-- Add a single click action for classes.
		do
			classes_single_click_agents.extend (p)
		end

	add_single_click_action_to_cluster (p: PROCEDURE [INTEGER, INTEGER, INTEGER, DOUBLE, DOUBLE, DOUBLE, INTEGER, INTEGER])
			-- Add a single click action for classes.
		do
			cluster_single_click_agents.extend (p)
		end

	show_stone (a_stone: STONE)
			-- Display node that represents `a_stone'.
		require
			a_stone_not_void: a_stone /= Void
		local
			l_grp: CONF_GROUP
			l_path: STRING_32
		do
			if attached {CLASSI_STONE} a_stone as classi_stone then
				l_grp := classi_stone.group
				l_path := classi_stone.class_i.config_class.path
			end
			if
				l_grp = Void and then
				attached {CLUSTER_STONE} a_stone as cluster_stone
			then
				l_grp := cluster_stone.group
				l_path := cluster_stone.path
			end
			if l_grp /= Void then
				check
					path_set: l_path /= Void
				end
				show_subfolder (l_grp, l_path)
			end
		end

	show_subfolder (a_group: CONF_GROUP; a_path: READABLE_STRING_32)
			-- Expand all parents of `a_group' and `a_path' and show the folder.
		require
			a_group_not_void: a_group /= Void
			a_path_not_void: a_path /= Void
		local
			path: LINKED_LIST [CONF_GROUP]
			a_folder: EB_CLASSES_TREE_FOLDER_ITEM
			l_sub: LIST [READABLE_STRING_32]
		do
			path := cluster_parents (a_group)
			from
				path.start
				a_folder := find_cluster_in (path.item, a_folder)
				if a_folder /= Void and then a_folder.is_expandable and not a_folder.is_expanded then
					a_folder.expand
				end
				path.forth
			until
				path.after or else a_folder = Void
			loop
				a_folder := find_cluster_in (path.item, a_folder)
				if a_folder /= Void and then a_folder.is_expandable and not a_folder.is_expanded then
					a_folder.expand
				end
				path.forth
			end
				-- Do nothing if there is no sub folder in the group.
				-- Make sure `a_folder' is selected later.
			if not a_path.is_empty then
				l_sub := a_path.split ('/')
				check
					not_empty: not l_sub.is_empty
				end
				from
					l_sub.start
				until
					l_sub.after or a_folder = Void
				loop
					a_folder := find_subfolder_in (l_sub.item, a_folder)
					if a_folder /= Void and then a_folder.is_expandable and not a_folder.is_expanded then
						a_folder.expand
					end
					l_sub.forth
				end
			end
			if a_folder /= Void then
				a_folder.enable_select
			end
		end

	show_class (a_class: CLASS_I)
			-- Expand all parents of `a_class' and highlight `a_class'.
		do
			show_subfolder (a_class.group, a_class.config_class.path)
			if
				attached {EB_CLASSES_TREE_FOLDER_ITEM} selected_item as a_folder and then
				attached find_class_in (a_class, a_folder) as a_class_item
			then
				a_class_item.enable_select
			end
		end

	show_target (a_target: CONF_TARGET)
			-- Expand all parents of `a_target' and highlight `a_target'.
		require
			a_target_not_void: a_target /= Void
		local
			a_target_item: EB_CLASSES_TREE_TARGET_ITEM
		do
			a_target_item := show_target_in (a_target, Void)
		end

	path_name_from_tree_node (tree_node: EV_TREE_NODE): STRING_32
			-- `Result' is a path name representing `tree_node' in the
			-- form "base.kernel.COMPARABLE".
		require
			tree_node_not_void: tree_node /= Void
		local
			n: EV_TREE_NODE
		do
			from
				n := tree_node
				Result := tree_node.text
			until
				not attached {EV_TREE_NODE} n.parent as p
			loop
				Result.prepend_character ('.')
				Result.prepend (p.text)
				n := p
			end
		ensure
			Result_not_void: Result /= Void
		end

	select_item_from_path (a_path: STRING)
			-- Select item associated with `a_path' if any.
		require
			a_path_not_void: a_path /= Void
		do
				-- If an item was selected before the rebuild, re-select
				-- the item.
			select_tree_item (a_path, Current)
			if selected_item /= Void and is_displayed then
					-- Ensure that the selected item is visible on screen.
				ensure_item_visible (selected_item)
			end
		end

feature -- Observer pattern

	refresh
			-- Rebuild the tree.
		do
			build_tree
		end

	on_class_added (a_class: EIFFEL_CLASS_I)
			-- Refresh the tree to display the new class.
		do
			refresh
		end

	on_class_removed (a_class: EIFFEL_CLASS_I)
			-- Refresh the tree not to display the old class.
		do
			refresh
		end

	on_class_moved (a_class: CONF_CLASS; old_group: CONF_GROUP; old_path: READABLE_STRING_32)
			-- Refresh the tree to display `a_class' in its new folder.
			-- `old_path' is old relative path in `old_group'
		do
			refresh
		end

	on_cluster_added (a_cluster: CLUSTER_I)
			-- Refresh the tree to display the new cluster.
		do
			refresh
		end

	on_cluster_changed (a_cluster: CLUSTER_I)
			-- Refresh the tree to display the modified cluster.
		do
			refresh
		end

	on_cluster_moved (a_cluster: EB_SORTED_CLUSTER; old_cluster: CLUSTER_I)
			-- Refresh the tree to display `a_cluster' in its new folder.
		do
			refresh
		end

	on_cluster_removed (a_group: EB_SORTED_CLUSTER; a_path: STRING)
			-- Refresh the tree not to display the old cluster.
		do
			refresh
		end

	on_project_loaded
			-- Refresh the tree to display the new project.
		do
			refresh
		end

	on_project_unloaded
			-- Erase the tree.
		do
			wipe_out
		end

feature {NONE} -- Status report

	has_readonly_items: BOOLEAN
			-- Shall read only items be shown in `Current'?
		do
			Result := True
		end

feature {NONE} -- Memory management

	internal_recycle
			-- Recycle `Current', but leave `Current' in an unstable state,
			-- so that we know whether we're still referenced or not.
		do
			manager.remove_observer (Current)
			from
				start
			until
				after
			loop
				if attached {EB_CLASSES_TREE_ITEM} item as l_item then
					l_item.recycle
				end
				forth
			end
			set_configurable_target_menu_handler (Void)
			window := Void
		end

feature {NONE} -- Rebuilding

	cluster_header: EB_CLASSES_TREE_HEADER_ITEM
			-- Header for clusters.

	override_header: EB_CLASSES_TREE_HEADER_ITEM
			-- Header for overrides.

	assembly_header: EB_CLASSES_TREE_HEADER_ITEM
			-- Header for assemblies.

	library_header: EB_CLASSES_TREE_HEADER_ITEM
			-- Header for libraries.

	expanded_clusters: HASH_TABLE [READABLE_STRING_32, READABLE_STRING_32]
		-- All cluster names marked as expanded during last call to
		-- `store_expanded_state'.

	selected_name: STRING_32
		-- Full name of item selected in `Current' before rebuilding,
		-- including path.

	store_expanded_state
			-- Store expanded state of `Current' into `expanded_clusters'.
		do
			expanded_clusters.wipe_out
				-- Clear last set of expanded clusters.

			if selected_item /= Void then
					-- Store inclusive path of item currently selected in `Current'.
					-- This is used to restore the selected item post rebuilding.
				selected_name := path_name_from_tree_node (selected_item)
			end
			recursive_store (Current)
				-- Actually perform recursion.
		end

	recursive_store (tree_list: EV_TREE_NODE_LIST)
			-- Store full path name of clusters associated with all
			-- expanded nodes of `tree_item', recursively into `expanded_clusters'.
		require
			tree_list_not_void: tree_list /= Void
		local
			current_node: EV_TREE_NODE
--			l_parent: EV_TREE_NODE
			l_name: STRING_32
		do
			from
				tree_list.start
			until
				tree_list.off
			loop
				current_node := tree_list.item
				if current_node.is_expanded then
					recursive_store (current_node)
--					l_parent ?= current_node.parent
					l_name := path_name_from_tree_node (current_node)
					expanded_clusters.put (l_name, l_name)
				end
				tree_list.forth
			end
		end

	restore_expanded_state
			-- Restore all nodes of `Current', represented in `expanded_clusters'.
		do
			across
				expanded_clusters as c
			loop
				expand_tree_item (c.key, Current)
			end
			if selected_name /= Void then
					-- If an item was selected before the rebuild, re-select
					-- the item.
				select_tree_item (selected_name, Current)
				if selected_item /= Void and is_displayed then
						-- Ensure that the selected item is visible on screen.
					ensure_item_visible (selected_item)
				end
			elseif not is_empty and is_displayed then
					-- Ensure that the first item is displayed.
					--| FIXME Julian Rogers 08/12/03
					--| When EiffelVision2 provides a method of returning the displayed index
					--| back to its exact original position, use this instead.
				ensure_item_visible (first)
			end
		end

	select_tree_item (full_path: STRING_32; tree_list: EV_TREE_NODE_LIST)
			-- Select item in `tree_list' recursively, whose data path matches `full_path'.
		require
			full_path_not_void: full_path /= Void
			tree_list_not_void: tree_list /= Void
		local
			key: STRING_32
			item_key: STRING_32
			dot_index: INTEGER
		do
			key := full_path
			dot_index := key.index_of ('.', 1)
			if dot_index = 0 then
					-- If there is no dot, `item_key' is set to `key'.
				item_key := key
			else
					-- Set `item_key' to the next part of `key' up to the dot.
				item_key := key.substring (1, dot_index - 1)
			end
			from
				tree_list.start
			until
				tree_list.off
			loop
				if tree_list.item.text.is_equal (item_key) or else tree_list.item.text.is_equal (item_key.as_upper) then
					if dot_index /= 0 then
						select_tree_item (full_path.substring (dot_index + 1,full_path.count), tree_list.item)
					else
						tree_list.item.enable_select
					end
				end
				tree_list.forth
			end
		end

	expand_tree_item (full_path: STRING_32; tree_item: EV_TREE_NODE_LIST)
			-- Expand item of `tree_item', whose data matches `full_path'.
		require
			full_path_not_void: full_path /= Void
			tree_item_not_void: tree_item /= Void
		local
			key: STRING_32
			item_key: STRING_32
			dot_index: INTEGER
		do
			key := full_path
			dot_index := key.index_of ('.', 1)
			item_key := key.substring (1, dot_index - 1)
			from
				tree_item.start
			until
				tree_item.off
			loop
				if tree_item.item.text.is_equal (item_key) or tree_item.item.text.is_equal (key) then
					if dot_index /= 0 then
						if tree_item.item.is_expandable and then not tree_item.item.is_expanded then
							tree_item.item.expand
						end
						expand_tree_item (full_path.substring (dot_index + 1, full_path.count), tree_item.item)
					else
						if tree_item.item.is_expandable and then not tree_item.item.is_expanded then
							tree_item.item.expand
						end
					end
				end
				tree_item.forth
			end
		end

feature {NONE} -- Implementation

	on_key_pushed (a_key: EV_KEY)
			-- If `a_key' is enter, set a stone in the development window.
		local
			titem: EV_TREE_NODE
			testfile: RAW_FILE
		do
			titem := selected_item
			if
				a_key.code = Key_enter and then
				window /= Void and then
				titem /= Void
			then
				if attached {EB_CLASSES_TREE_CLASS_ITEM} titem as conv_class then
					create testfile.make_with_path (conv_class.data.file_name)
					if testfile.exists and then testfile.is_readable then
						window.set_stone (conv_class.stone)
					else
						prompts.show_warning_prompt ("Class file could not be read. Removing class from the system.", Void, Void)
						manager.remove_class (conv_class.data)
					end
				elseif attached {EB_CLASSES_TREE_FOLDER_ITEM} titem as conv_cluster then
					window.set_stone (conv_cluster.stone)
				end
			end
		end

	on_cluster_drop (a_cluster: CLUSTER_STONE)
			-- Move `a_cluster' to the tree root.
		do
--			manager.move_cluster (a_cluster.cluster_i, Void)
		end

	cluster_parents (a_group: CONF_GROUP): LINKED_LIST [CONF_GROUP]
			-- List of parent groups of `group', from the root to `group', `cluster' included.
		local
			l_group, l_next_group: CONF_GROUP
			l_sys: CONF_SYSTEM
			l_search_table: SEARCH_TABLE [CONF_GROUP]
		do
			l_sys := universe.target.system
			from
				create Result.make
					-- Table to avoid loop.
				create l_search_table.make (5)
				l_group := a_group
			until
				l_group = Void or else l_search_table.has (l_group) -- root attained
			loop
				Result.put_front (l_group)
				l_search_table.force (l_group)
				if l_group.is_cluster then
					check cluster: attached {CONF_CLUSTER} l_group as l_cluster then
						l_next_group := l_cluster.parent
					end
				else
					l_next_group := Void
				end
				if l_next_group = Void then
					l_next_group := l_group.target.system.lowest_used_in_library
						-- Is already root system. We don't even try another route.
					if l_group.target.system = l_sys then
						l_next_group := Void
					end
				end
				l_group := l_next_group
			end
		ensure
			result_not_void: Result /= Void
			result_not_empty: not Result.is_empty
		end

	find_subfolder_in (a_name: READABLE_STRING_32; parent_cluster: EB_CLASSES_TREE_FOLDER_ITEM): EB_CLASSES_TREE_FOLDER_ITEM
			-- Fint the tree item associated to `a_name' in `parent_cluster'.
		require
			parent_cluster_not_void: parent_cluster /= Void
		do
			from
				parent_cluster.start
			until
				parent_cluster.after or Result /= Void
			loop
				if
					attached {EB_CLASSES_TREE_FOLDER_ITEM} parent_cluster.item as l_folder and then
					l_folder.name.same_string (a_name)
				then
					Result := l_folder
				end
				parent_cluster.forth
			end
		end

	find_cluster_in (clusteri: CONF_GROUP; parent_cluster: EB_CLASSES_TREE_FOLDER_ITEM): EB_CLASSES_TREE_FOLDER_ITEM
			-- Find the tree item associated to `clusteri' in `parent_cluster'.
		local
			folder_list: EV_TREE_NODE_LIST
		do
			if parent_cluster = Void then
				if clusteri.is_override then
					folder_list := override_header
				elseif clusteri.is_cluster then
					folder_list := cluster_header
				elseif clusteri.is_assembly or clusteri.is_physical_assembly then
					folder_list := assembly_header
				elseif clusteri.is_library then
					folder_list := library_header
				else
					check should_not_reach: False end
				end
			else
				if not parent_cluster.is_initialized then
					parent_cluster.initialize
				end
				folder_list := parent_cluster
			end

			from
				folder_list.start
			until
				folder_list.after or else Result /= Void
			loop
				if
					attached {EB_CLASSES_TREE_FOLDER_ITEM} folder_list.item as folder and then
					folder.data.actual_group = clusteri
				then
					Result := folder
				end
				folder_list.forth
			end
		end

	find_class_in (a_class: CLASS_I; parent_cluster: EB_CLASSES_TREE_FOLDER_ITEM): EB_CLASSES_TREE_CLASS_ITEM
			-- Find the tree item associated to `a_class' in `parent_cluster'.
		local
			folder_list: EV_TREE_NODE_LIST
		do
			if parent_cluster = Void then
				folder_list := Current
			else
				folder_list := parent_cluster
			end

			from
				folder_list.start
			until
				folder_list.after or else Result /= Void
			loop
				if
					attached {EB_CLASSES_TREE_CLASS_ITEM} folder_list.item as folder and then
					folder.data = a_class
				then
					Result := folder
				end
				folder_list.forth
			end
		end

	show_target_in (a_target: CONF_TARGET; a_parent: detachable EB_CLASSES_TREE_TARGET_ITEM): detachable EB_CLASSES_TREE_TARGET_ITEM
			-- Find the tree item associated to `a_target' under `a_parent' and highlight `a_target'.
			-- Expand if found.
		require
			a_target_not_void: a_target /= Void
		do
			if a_parent /= Void then
				if a_parent.data = a_target then
					a_parent.enable_select
					Result := a_parent
				else
					across
						a_parent as l_c
					until attached Result
					loop
						if attached {EB_CLASSES_TREE_TARGET_ITEM} l_c.item as l_target_item then
							Result := show_target_in (a_target, l_target_item)
						end
					end
					if attached Result as l_result then
						a_parent.expand
					end
				end
			else
				across
					Current as l_c
				until attached Result
				loop
					if attached {EB_CLASSES_TREE_TARGET_ITEM} l_c.item as l_item then
						Result := show_target_in (a_target, l_item)
					end
				end
			end
		end

	window: EB_DEVELOPMENT_WINDOW
			-- Development window classes should be associated with.

	textable: EV_TEXT_COMPONENT
			-- Text component classes should be associated with.

	build_group_tree (a_list: EV_DYNAMIC_LIST [EV_CONTAINABLE]; a_grps: DS_ARRAYED_LIST [EB_SORTED_CLUSTER]; a_header: EB_CLASSES_TREE_HEADER_ITEM)
			-- Build a tree for `a_grps' under `a_header' and add it to the tree if we have elements.
			-- Attach the tree to `a_list'
		require
			a_list_not_void: a_list /= Void
			a_grps_not_void: a_grps /= Void
			a_header_not_void: a_header /= Void
		local
			l_item: EB_CLASSES_TREE_FOLDER_ITEM
			l_group: EB_SORTED_CLUSTER
			l_agents: like classes_double_click_agents
		do
			from
				a_grps.start
			until
				a_grps.after
			loop
				l_group := a_grps.item_for_iteration
				if has_readonly_items or l_group.is_writable then
					l_item := create_folder_item (l_group)

					if textable /= void and not is_show_classes then
						l_item.set_associated_textable (textable)
					end

					a_header.extend (l_item)
					l_item.associate_with_window (window)
					if textable /= Void then
						l_item.associate_textable_with_classes (textable)
					end

					l_agents := classes_double_click_agents
					from
						l_agents.start
					until
						l_agents.after
					loop
						l_item.add_double_click_action_to_classes (l_agents.item)
						l_agents.forth
					end
					l_agents := cluster_double_click_agents
					from
						l_agents.start
					until
						l_agents.after
					loop
						l_item.add_double_click_action_to_cluster (l_agents.item)
						cluster_double_click_agents.forth
					end
					l_agents := classes_single_click_agents
					from
						l_agents.start
					until
						l_agents.after
					loop
						l_item.add_single_click_action_to_classes (l_agents.item)
						l_agents.forth
					end
					l_agents := cluster_single_click_agents
					from
						l_agents.start
					until
						l_agents.after
					loop
						l_item.add_single_click_action_to_cluster (l_agents.item)
						l_agents.forth
					end
				end
				a_grps.forth
			end
			if not a_header.is_empty then
				a_list.extend (a_header)
				a_header.expand
			end
		end

	build_target_tree (a_list: EV_DYNAMIC_LIST [EV_CONTAINABLE])
			-- Build a tree for the targets of the current system, that make up the application target.
			-- Attach the tree to `a_list'
		require
			a_list_not_void: a_list /= Void
		local
			l_target: detachable CONF_TARGET
			l_item, l_new_item: EB_CLASSES_TREE_TARGET_ITEM
		do
			l_target := universe.target
			if attached l_target then
				from
					create l_item.make (l_target)
				until
					l_target.extends = Void
				loop
					l_target := l_target.extends
					create l_new_item.make (l_target)
					l_new_item.extend (l_item)
					l_item := l_new_item
				end
				a_list.extend (l_item)
				l_item.associate_with_window (window)
			end
		end

	has_targets: BOOLEAN
			-- Is tree showing targets?

	groups_from_sorted_clusters (a_sorted_clusters: DS_LIST [EB_SORTED_CLUSTER]; a_recursive: BOOLEAN): LIST [CONF_GROUP]
			-- List of groups from `a_sorted_clusters'.
			-- If `a_recursive' is True, retrieve groups recursively.
		local
			l_group_set: DS_HASH_SET [CONF_GROUP]
			l_set_cursor: DS_HASH_SET_CURSOR [CONF_GROUP]
			l_list_cursor: DS_LIST_CURSOR [EB_SORTED_CLUSTER]
		do
			create {LINKED_LIST [CONF_GROUP]} Result.make
			if a_sorted_clusters /= Void then
				create l_group_set.make (10)
				l_list_cursor := a_sorted_clusters.new_cursor
				from
					l_list_cursor.start
				until
					l_list_cursor.after
				loop
					find_groups (l_list_cursor.item, l_group_set, a_recursive)
					l_list_cursor.forth
				end

				l_set_cursor := l_group_set.new_cursor
				from
					l_set_cursor.start
				until
					l_set_cursor.after
				loop
					Result.extend (l_set_cursor.item)
					l_set_cursor.forth
				end
			end
		ensure
			result_attached: Result /= Void
		end

	find_groups (a_source: EB_SORTED_CLUSTER; a_group_set: DS_HASH_SET [CONF_GROUP]; a_recursive: BOOLEAN)
			-- Find groups from `a_source' and store them in `a_group_set'.
			-- If `a_recursive' is True, search for groups recursively.
		require
			a_source_attached: a_source /= Void
			a_group_set_attached: a_group_set /= Void
		local
			l_group: CONF_GROUP
			l_children: DS_LINKED_LIST [EB_SORTED_CLUSTER]
			l_cursor: DS_LINKED_LIST_CURSOR [EB_SORTED_CLUSTER]
		do
			l_group := a_source.actual_group
			if l_group /= Void and then not a_group_set.has (l_group) then
				a_group_set.force_last (l_group)
				if a_recursive then
					create l_children.make
					safe_append_list (l_children, a_source.clusters)
					safe_append_list (l_children, a_source.overrides)
					safe_append_list (l_children, a_source.libraries)
					safe_append_list (l_children, a_source.assemblies)
					l_cursor := l_children.new_cursor
					from
						l_cursor.start
					until
						l_cursor.after
					loop
						find_groups (l_cursor.item, a_group_set, a_recursive)
						l_cursor.forth
					end
				end
			end
		end

	safe_append_list (a_source: DS_LIST [EB_SORTED_CLUSTER]; a_dest: DS_LIST [EB_SORTED_CLUSTER])
			-- If `a_dest' is not Void, append it to `a_source'.
		require
			a_source_attached: a_source /= Void
		do
			if a_dest /= Void then
				a_source.append_last (a_dest)
			end
		end

	is_group_valid (a_data: ANY): BOOLEAN
			-- Does `a_data' contain valid groups information?
		do
			if a_data = Void then
				Result := True
			else
				if attached {LIST [CONF_GROUP]} a_data as l_groups then
					Result := l_groups.for_all (agent (a_group: CONF_GROUP): BOOLEAN do Result := a_group /= Void and then a_group.is_valid end)
				end
			end
		end

	is_show_classes: BOOLEAN
			-- Show classes notes?

	is_class_selection_only: BOOLEAN
			-- Is tree only used for the purpose of selecting an existing class from the universe?

feature {EB_CLASSES_TREE_ITEM} -- Implementation

	on_post_folder_loaded (a_item: EV_TREE_ITEM)
			-- Called when a folder item has been expanded
			-- for the first time.
		do
		end

feature {NONE} -- Factory

	create_folder_item (a_group: EB_SORTED_CLUSTER): EB_CLASSES_TREE_FOLDER_ITEM
			-- Create new folder item
		do
			create Result.make_with_option (a_group, is_show_classes)
		end

feature {EB_CLASSES_TREE_ITEM} -- Protected Properties

	context_menu_factory: EB_CONTEXT_MENU_FACTORY
			-- Context menu factory

	classes_double_click_agents: LINKED_LIST [PROCEDURE [INTEGER, INTEGER, INTEGER, DOUBLE, DOUBLE, DOUBLE, INTEGER, INTEGER]]
			-- Agents associated to double-clicks on classes.

	cluster_double_click_agents: LINKED_LIST [PROCEDURE [INTEGER, INTEGER, INTEGER, DOUBLE, DOUBLE, DOUBLE, INTEGER, INTEGER]];
			-- Agents associated to double-clicks on clusters.

	classes_single_click_agents: LINKED_LIST [PROCEDURE [INTEGER, INTEGER, INTEGER, DOUBLE, DOUBLE, DOUBLE, INTEGER, INTEGER]]
			-- Agents associated to single-click on classes.

	cluster_single_click_agents: LINKED_LIST [PROCEDURE [INTEGER, INTEGER, INTEGER, DOUBLE, DOUBLE, DOUBLE, INTEGER, INTEGER]];
			-- Agents associated to single-click on clusters.

	set_last_pressed_item (a_item: like last_pressed_item)
			-- Set `last_pressed_item' with `a_item'
		do
			last_pressed_item := a_item
		end

	last_pressed_item: EB_CLASSES_TREE_ITEM
			-- Last pressed item.

invariant
	classes_double_click_agents_not_void: classes_double_click_agents /= Void
	cluster_double_click_agents_not_void: cluster_double_click_agents /= Void
	classes_single_click_agents_not_void: classes_single_click_agents /= Void
	cluster_single_click_agents_not_void: cluster_single_click_agents /= Void
	expanded_clusters_not_void: expanded_clusters /= Void

note
	copyright:	"Copyright (c) 1984-2022, Eiffel Software"
	license:	"GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)"
	licensing_options:	"http://www.eiffel.com/licensing"
	copying: "[
			This file is part of Eiffel Software's Eiffel Development Environment.
			
			Eiffel Software's Eiffel Development Environment is free
			software; you can redistribute it and/or modify it under
			the terms of the GNU General Public License as published
			by the Free Software Foundation, version 2 of the License
			(available at the URL listed under "license" above).
			
			Eiffel Software's Eiffel Development Environment is
			distributed in the hope that it will be useful, but
			WITHOUT ANY WARRANTY; without even the implied warranty
			of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
			See the GNU General Public License for more details.
			
			You should have received a copy of the GNU General Public
			License along with Eiffel Software's Eiffel Development
			Environment; if not, write to the Free Software Foundation,
			Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
		]"
	source: "[
			Eiffel Software
			5949 Hollister Ave., Goleta, CA 93117 USA
			Telephone 805-685-1006, Fax 805-685-6869
			Website http://www.eiffel.com
			Customer support http://support.eiffel.com
		]"

end