#
# Sensus Consulting Ltd (C) 1997-1998
# Matt Newman <matt@sensus.org>
#
# Very experimental - included just for fun!
#
# Implements a very very simplistic Win95-like Explorer.
#
#INDEX\
proc tk++::Explorer {} {}

package require tk++

proc explorer {w args} {return [eval tk++::Explorer $w $args]}

class tk++::Explorer {
	inherit tk++::ExplorerShell

	constructor {args} {}

	public method activate {id mode}
	public method expand {id mode}
	public method context {id x y}

	itk_option define -url url URL {file://}

	protected method _populate {id {force 0}}
	protected method _properties {id}
	protected method listCallback {url}

	protected variable lastIcon ""
	protected variable id2url		;# ARRAY
	protected variable url2id		;# ARRAY
}
configbody tk++::Explorer::url {
	configure -title "Exploring - $itk_option(-url)"
	$itk_component(rightlabel) configure \
			-text "Contents of '$itk_option(-url)'"
}
body tk++::Explorer::constructor {args} {
	menubar add menu Windows -menu {
		command Desktop		-command {NewWindow -url file://}
		command Registry	-command {NewWindow -url registry://}
		command LDAP		-command {NewWindow -url ldap://}
		command {MS Installer}	-command {NewWindow -url msi://}
		separator
		command {Tk Windows}	-command {NewWindow -url tk://}
		command {Tcl Namespace}	-command {NewWindow -url tcl://}
		command {Tcl++ Classes}	-command {NewWindow -url tcl++://}
	}
	$itk_component(leftlabel) conf -text {All Folders}

	eval itk_initialize $args

	regsub {^([^:]*)://(.*)$} $itk_option(-url) {{\1} {\2}} data
	lassign $data type path

	array set c [url::$type configure $path]
	set id2url(0) $itk_option(-url)
	set url2id($itk_option(-url)) 0
	if {![info exists c(-image)]} {
		set c(-image) [img folder]
	}
	$itk_component(treeview) put 0 \
			name $c(-name) image $c(-image) \
			-url $itk_option(-url)

	_populate 0
}
body tk++::Explorer::listCallback {url} {

#echo SELECTED $this $url
	status "invoking $url"

	if {![info exists url2id($url)]} {
		status "can't find $url in tree!"
		return
	}
	set id $url2id($url)
	set pid [$itk_component(treeview) parent $id]
	$itk_component(treeview) expand $pid
	$itk_component(treeview) activate $id
}
body tk++::Explorer::activate {id mode} {

	if !$mode {
		$itk_component(treeview) put $id image $lastIcon
		$itk_component(rightlabel) conf -text ""
		return
	}
#echo [list _ACTIVATE $this $id $mode ]

	set lastIcon [$itk_component(treeview) get $id image]
	if ![catch {img ${lastIcon}-selected} img] {
		$itk_component(treeview) put $id image $img
	}
	configure -url $id2url($id)

	component hull configure -cursor watch
	$itk_component(listview) clear

	_populate $id

	foreach cid [$itk_component(treeview) children $id] {
		set data [$itk_component(treeview) get $cid]
		$itk_component(listview) insert end \
			[pget $data name] [pget $data image] [pget $data -url]
	}
	component hull configure -cursor {}
}
body tk++::Explorer::context {id x y} {

	set menu $itk_component(contextMenu)
	$menu delete 0 end

	set url $id2url($id)
	regsub {^([^:]*)://(.*)$} $url {{\1} {\2}} data
	lassign $data type path

	#
	# Allow driver to add context sensitive entries to menu
	#
	if [catch {url::$type context $path $menu} err] {
		puts stderr "context: $err"
	}

	$menu add sep
	$menu add com -label Cut
	$menu add com -label Copy
	$menu add sep
	$menu add com -label Delete -command [code $itk_component(treeview) delete $id]
	$menu add com -label Rename
	$menu add sep
	$menu add com -label Properties -command [code $this _properties $id]

	incr x [winfo rootx $itk_component(treeview)]
	incr y [winfo rooty $itk_component(treeview)]

	tk_popup $menu $x $y
	#
	# Force a refresh
	#
	_populate $id 1
}
body tk++::Explorer::expand {id mode} {
	if !$mode return

	component hull conf -cursor watch

	_populate $id

	component hull conf -cursor {}
}
#
# This routine fetches the children from the driver,
# and also (if forced) flushes entries that no longer exist
# from TreeView.
#
body tk++::Explorer::_populate {id {force 0}} {

	set children [$itk_component(treeview) children $id]
	set url $id2url($id)
	regsub {^([^:]*)://(.*)$} $url {{\1} {\2}} data
	lassign $data type path

	if {!$force && $children != ""} return

	ainit cur
	foreach cid $children {
		set cur($id2url($cid)) $cid
	}

	set dirs {}
	set leafs {}
	foreach child [url::$type children $path] {
		set cpath	[url::$type join $path $child]
		set curl	${type}://$cpath

		aset c [url::$type configure $cpath] $curl,

		if {![info exists c($curl,-container)] ||\
			$c($curl,-container)} {
			lappend dirs $curl
		} else {
			lappend leafs $curl
		}
	}
	set dirs	[lsort $dirs]
	set leafs	[lsort $leafs]
	foreach cp $dirs {
		if ![info exists cur($cp)] {
			set url2id($cp) [$itk_component(treeview) add $id \
					name $c($cp,-name) image $c($cp,-image) -url $cp]
			set id2url($url2id($cp)) $cp
		} else {
			unset cur($cp)
		}
	}
	foreach cp $leafs {
		if ![info exists cur($cp)] {
			set url2id($cp) [$itk_component(treeview) add $id \
					name $c($cp,-name) image $c($cp,-image) -url $cp]
			set id2url($url2id($cp)) $cp
		} else {
			unset cur($cp)
		}
	}
	foreach cp [array names cur] {
		$itk_component(treeview) delete $cur($cp)
		unset id2url($url2id($cp))
		unset url2id($cp)
	}
}
body tk++::Explorer::_properties {id} {
#echo [list _PROPERTIES $this $id]

	set url $id2url($id)
	regsub {^([^:]*)://(.*)$} $url {{\1} {\2}} data
	lassign $data type path

	array set opts [url::$type configure $path]

	set msg {}
	foreach opt [lsort [array names opts]] {
		append msg "$opt\t$opts($opt)\n"
	}
	tk_messageBox -title $opts(-name) -parent $itk_interior -message $msg
}