#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Netspace.tcl,v $
# $Date: 1996/12/06 10:37:58 $
# $Revision: 1.18.1.12 $
#
# ----------------------------------------------------------------------
#   AUTHOR:  Lindsay Marshall <lindsay.marshall@newcastle.ac.uk>
# ----------------------------------------------------------------------
# Copyright 1995 The University of Newcastle upon Tyne (see COPYRIGHT)
# ======================================================================
#
package provide zircon 1.18
#
proc Netspace {name args} {
    global currentNet
    switch {} $currentNet {} default {
	if [notDefaultNet] { error "Nested Netspace directive for $name."}
    }
    nsLoad $name 0 $args
}
#
proc nsLoad {name show opts} {
    global XTO currentNet DEBUG zircon
    set f [file join $zircon(prefdir) netspaces $name]
    if ![file exists $f] {
	tellError {} Netspace "Cannot find Netspace $name"
	return 0
    }
    if [file isdirectory $f] {
	set f [file join $f preferences]
	if ![file exists $f] {
	    tellError {} Netspace "Cannot find Netspace preferences for $name"
	    return 0
	}
    }
    set ln [string tolower $name]
    if [info exists XTO($ln)] {
	for {set i 1} {[info exists XTO($ln$i)]} {incr i} {}
	set nn1 $name$i
	if ![askUser {} {Netspace Load} "Netspace \"$name\" is already loaded.\
It will be loaded under the name \"$nn1\"."] return
	addToNM $nn1
    } {
	set nn1 $name
    }
    set sc $currentNet
    set currentNet [Net $nn1]
    makeDefaults $currentNet
    if [catch {source $f} msg] {
	tellError {} {Netspace error} "Error in netspace $nn1 - $msg"
    } {
	InitNet $currentNet
	$currentNet show
	if $show {
	    exposeFrame .@ctl $currentNet
	    exposeFrame .@inf $currentNet
	}
	if $DEBUG { zDBGAdd $currentNet }
    }
    set currentNet $sc
    setUnload $nn1 normal
}
#
proc nsDelete {name} {
    if ![askUser {} {Delete Netspace} \
       "Are you sure you want to delete Netspace \"$name\""] return
    global zircon
    filedirdel [file join $zircon(prefdir) netspaces $name]
    delFromNsM $name
}
#
proc nsClone {name} {
    global ztrans
    mkEntryBox {} "Cloning $name" \
      {Enter the name for the cloned Netspace:} \
      "{$ztrans(name) {}}" "$ztrans(ok) {nsAddClone [list $name]}" \
      "$ztrans(dismiss) {}"
}
#
proc nsAddClone {old new} {
    switch {} $new return
    global zircon
    foreach x [Net :: list] {
	switch -- [$x name] $new {
	    tellError {} {Clone Error} "Netscape \"$new\" already exists."
	    return
	}
    }
    set dir [file join $zircon(prefdir) netspaces]
    set of [file join $dir $old]
    set nf [file join $dir $new]
    if [file isdirectory $of] {
	if [catch {filemkdir $nf} msg] {
	    tellError {} "Clone Error" $msg
	    return
	}
	foreach x [glob -nocomplain [file join $of *]] {
	    filecopy $x $nf
	}
    } {
	if [catch {filecopy $of $nf} msg] {
	    tellError {} "Clone Error" $msg
	}
    }
    addToNsM $new
}
#
proc nsUnload {name} {
    global zircon
    foreach x [Net :: list] {
	switch -- [$x name] $name {
	    if ![file exists [file join $zircon(prefdir) netspaces $name]] {
		delFromNM [$x name]
	    } {
		setUnload $name disabled
	    }
	    $x delete
	    break
	}
    }
}
#
proc notDefaultNet {} {
    global currentNet defaultNet
    switch $currentNet $defaultNet {return 0}
    return 1
}
#
proc isNotDefaultNet {net} {
    global defaultNet
    switch $net $defaultNet {return 0}
    return 1
}
