Procedures dumpCfg and loadCfg separated in cfgparse.tcl (moved from

editor.tcl)

Each node now tagged with a canvas ID (muliple canvas / pages support
commin soon in editor.tcl)

Bug found by:
Submitted by:
Requested by:
Reviewed by:
Approved by:
Obtained from:

diff --git a/canvas.tcl b/canvas.tcl
new file mode 100755 (executable)
index 0000000..694cc4e
--- /dev/null
+++ b/canvas.tcl
@@ -0,0 +1,46 @@
+#
+# Copyright 2005 University of Zagreb, Croatia.  All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+# 3. All advertising materials mentioning features or use of this software
+#    must display the following acknowledgement:
+# This product includes software developed by the University of Zagreb,
+# Croatia and its contributors.
+# 4. Neither the name of the University nor the names of its contributors
+#    may be used to endorse or promote products derived from this software
+#    without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+
+
+proc removeCanvas { canvas } {
+    puts "removeCanvas $canvas"
+}
+
+
+proc newCanvas { name } {
+    global canvass
+
+    set canvas c0
+    global $canvas
+    lappend canvass $canvas
+    set $canvas {{name default}}
+}

diff --git a/cfgparse.tcl b/cfgparse.tcl
new file mode 100755 (executable)
index 0000000..5bd4eb4
--- /dev/null
+++ b/cfgparse.tcl
@@ -0,0 +1,296 @@
+#
+# Copyright 2005 University of Zagreb, Croatia.  All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+# 3. All advertising materials mentioning features or use of this software
+#    must display the following acknowledgement:
+# This product includes software developed by the University of Zagreb,
+# Croatia and its contributors.
+# 4. Neither the name of the University nor the names of its contributors
+#    may be used to endorse or promote products derived from this software
+#    without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+# This work was supported in part by the Croatian Ministry of Science
+# and Technology through the research contract #IP-2003-143.
+#
+
+
+proc dumpputs {method dest string} {
+    switch -exact -- $method {
+       file {
+           puts $dest $string
+       }
+       string {
+           global $dest
+           append $dest "$string\r"
+       }
+    }
+    return
+}
+
+
+proc dumpCfg {method dest} {
+    global nodes links canvass
+    global showIfNames showIfIPaddrs showNodeLabels showLinkLabels
+
+    foreach node $nodes {
+       global $node
+       upvar 0 $node lnode
+       dumpputs $method $dest "node $node \{"
+       foreach element $lnode {
+           if { "[lindex $element 0]" == "network-config" } {
+               dumpputs $method $dest "    network-config \{"
+               foreach line [lindex $element 1] {
+                   dumpputs $method $dest "    $line"
+               }
+               dumpputs $method $dest "    \}"
+           } elseif { "[lindex $element 0]" == "custom-config" } {
+               dumpputs $method $dest "    custom-config \{"
+               foreach line [lindex $element 1] {
+                   dumpputs $method $dest "    $line"
+               }
+               dumpputs $method $dest "    \}"
+           } else {
+               dumpputs $method $dest "    $element"
+           }
+       }
+       dumpputs $method $dest "\}"
+       dumpputs $method $dest ""
+    }
+
+    foreach link $links {
+       global $link
+       upvar 0 $link llink
+       dumpputs $method $dest "link $link \{"
+       foreach element $llink {
+               dumpputs $method $dest "    $element"
+       }
+       dumpputs $method $dest "\}"
+       dumpputs $method $dest ""
+    }
+
+    foreach canvas $canvass {
+       global $canvas
+       upvar 0 $canvas lcanvas
+       dumpputs $method $dest "canvas $canvas \{"
+       foreach element $lcanvas {
+               dumpputs $method $dest "    $element"
+       }
+       dumpputs $method $dest "\}"
+       dumpputs $method $dest ""
+    }
+
+    dumpputs $method $dest "option show \{"
+    if {$showIfNames == 0} { 
+        dumpputs $method $dest "    interface_names no" 
+    } else {
+        dumpputs $method $dest "    interface_names yes" }
+    if {$showIfIPaddrs == 0} { 
+        dumpputs $method $dest "    ip_addresses no" 
+    } else {
+        dumpputs $method $dest "    ip_addresses yes" }
+    if {$showNodeLabels == 0} { 
+        dumpputs $method $dest "    node_labels no" 
+    } else {
+        dumpputs $method $dest "    node_labels yes" }
+    if {$showLinkLabels == 0} { 
+        dumpputs $method $dest "    link_labels no" 
+    } else {
+        dumpputs $method $dest "    link_labels yes" }
+    dumpputs $method $dest "\}"
+    dumpputs $method $dest ""
+
+    return
+}
+
+
+proc loadCfg { cfg } {
+    global nodes links canvass
+    global showIfNames showIfIPaddrs showNodeLabels showLinkLabels
+
+    # Cleanup first - this also automatically deletes all associated links
+    # XXX remove this - Tk polution!
+    foreach node $nodes {
+       removeGUINode $node
+    }
+    foreach canvas $canvass {
+       removeCanvas $canvas
+    }
+
+    set class ""
+    set object ""
+    foreach entry $cfg {
+       if {"$class" == ""} {
+           set class $entry
+           continue
+       } elseif {"$object" == ""} {
+           set object $entry
+           global $object
+           if {"$class" == "node"} {
+               lappend nodes $object
+           }
+           if {"$class" == "link"} {
+               lappend links $object
+           }
+           if {"$class" == "canvas"} {
+               lappend canvass $object
+           }
+           if {"$class" == "option"} {
+                # for future use
+               lappend prefs $object
+           }
+           continue
+       } else {
+           set line [concat $entry]
+           while {[llength $line] >= 2} {
+               set field [lindex $line 0]
+               if {"$field" == ""} {
+                   set line [lreplace $line 0 0]
+                   continue
+               }
+               set value [lindex $line 1]
+               set line [lreplace $line 0 1]
+               if {"$class" == "node"} {
+                   switch -exact -- $field {
+                       type {
+                           lappend $object "type {$value}"
+                       }
+                       model {
+                           lappend $object "model {$value}"
+                       }
+                       cpu {
+                           lappend $object "cpu {$value}"
+                       }
+                       interface-peer {
+                           lappend $object "interface-peer {$value}"
+                       }
+                       network-config {
+                           set cfg ""
+                           foreach zline [split $value {\r}] {
+                               if { [string index "$zline" 0] == "     " } {
+                                   set zline [string replace "$zline" 0 0]
+                                   lappend cfg $zline
+                               }
+                           }
+                           lappend $object "network-config {$cfg}"
+                       }
+                       custom-enabled {
+                           lappend $object "custom-enabled {$value}"
+                       }
+                       custom-command {
+                           lappend $object "custom-command {$value}"
+                       }
+                       custom-config {
+                           set cfg ""
+                           foreach zline [split $value {\r}] {
+                               if { [string index "$zline" 0] == "     " } {
+                                   set zline [string replace "$zline" 0 0]
+                                   lappend cfg $zline
+                               }
+                           }
+                           lappend $object "custom-config {$cfg}"
+                       }
+                       iconcoords {
+                           lappend $object "iconcoords {$value}"
+                       }
+                       labelcoords {
+                           lappend $object "labelcoords {$value}"
+                       }
+                       canvas {
+                           lappend $object "canvas {$value}"
+                       }
+                   }
+               } elseif {"$class" == "link"} {
+                   switch -exact -- $field {
+                       nodes {
+                           lappend $object "nodes {$value}"
+                       }
+                       bandwidth {
+                           lappend $object "bandwidth $value"
+                       }
+                       delay {
+                           lappend $object "delay $value"
+                       }
+                       ber {
+                           lappend $object "ber $value"
+                       }
+                       duplicate {
+                           lappend $object "duplicate $value"
+                       }
+                   }
+               } elseif {"$class" == "canvas"} {
+                   switch -exact -- $field {
+                       name {
+                           lappend $object "name {$value}"
+                       }
+                   }
+               } elseif {"$class" == "option"} {
+                   switch -exact -- $field {
+                       interface_names {
+                            if { $value == "no" } {
+                                set showIfNames 0
+                            } elseif { $value == "yes" } {
+                                set showIfNames 1
+                            }
+                       }
+                       ip_addresses {
+                            if { $value == "no" } {
+                                set showIfIPaddrs 0
+                            } elseif { $value == "yes" } {
+                                set showIfIPaddrs 1
+                            }
+                       }
+                       node_labels {
+                            if { $value == "no" } {
+                                set showNodeLabels 0
+                            } elseif { $value == "yes" } {
+                                set showNodeLabels 1
+                            }
+                       }
+                       link_labels {
+                            if { $value == "no" } {
+                                set showLinkLabels 0
+                            } elseif { $value == "yes" } {
+                                set showLinkLabels 1
+                            }
+                       }
+                   }
+                }
+           }
+       }
+       set class ""
+       set object ""
+    }
+    return
+}
+
+
+proc newObjectId { type } {
+    global nodes links canvass
+
+    set mark [string range [set type] 0 0]
+    set id 0
+    while {[lsearch [set [set type]s] "$mark$id"]  != -1} {
+        incr id
+    }
+    return $mark$id
+}

diff --git a/editor.tcl b/editor.tcl
index 43f98a7f0aa16839af06ae7addc27acffc2bdb7f..4c47aa55078e4d68859829ac819d74ccae58ea9b 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -78,20 +78,6 @@ proc removeGUINode { node } {
 }
 
 
-proc dumpputs {method dest string} {
-    switch -exact -- $method {
-       file {
-           puts $dest $string
-       }
-       string {
-           global $dest
-           append $dest "$string\r"
-       }
-    }
-    return
-}
-
-
 proc updateUndoLog {} {
     global changed undolog undolevel redolevel
 
@@ -108,215 +94,31 @@ proc updateUndoLog {} {
 }
 
 
-proc dumpCfg {method dest} {
-    global nodes links
-    global showIfNames showIfIPaddrs showNodeLabels showLinkLabels
-
-    foreach node $nodes {
-       global $node
-       upvar 0 $node lnode
-       dumpputs $method $dest "node $node \{"
-       foreach element $lnode {
-           if { "[lindex $element 0]" == "network-config" } {
-               dumpputs $method $dest "    network-config \{"
-               foreach line [lindex $element 1] {
-                   dumpputs $method $dest "    $line"
-               }
-               dumpputs $method $dest "    \}"
-           } elseif { "[lindex $element 0]" == "custom-config" } {
-               dumpputs $method $dest "    custom-config \{"
-               foreach line [lindex $element 1] {
-                   dumpputs $method $dest "    $line"
-               }
-               dumpputs $method $dest "    \}"
-           } else {
-               dumpputs $method $dest "    $element"
-           }
-       }
-       dumpputs $method $dest "\}"
-       dumpputs $method $dest ""
-    }
+proc undo {} {
+    global undolevel undolog oper_mode
 
-    foreach link $links {
-       global $link
-       upvar 0 $link llink
-       dumpputs $method $dest "link $link \{"
-       foreach element $llink {
-               dumpputs $method $dest "    $element"
-       }
-       dumpputs $method $dest "\}"
-       dumpputs $method $dest ""
+    if {$oper_mode == "edit" && $undolevel > 0} {
+       incr undolevel -1
+       loadCfg $undolog($undolevel)
+       redrawAll
     }
-
-    dumpputs $method $dest "option show \{"
-    if {$showIfNames == 0} { 
-        dumpputs $method $dest "    interface_names no" 
-    } else {
-        dumpputs $method $dest "    interface_names yes" }
-    if {$showIfIPaddrs == 0} { 
-        dumpputs $method $dest "    ip_addresses no" 
-    } else {
-        dumpputs $method $dest "    ip_addresses yes" }
-    if {$showNodeLabels == 0} { 
-        dumpputs $method $dest "    node_labels no" 
-    } else {
-        dumpputs $method $dest "    node_labels yes" }
-    if {$showLinkLabels == 0} { 
-        dumpputs $method $dest "    link_labels no" 
-    } else {
-        dumpputs $method $dest "    link_labels yes" }
-    dumpputs $method $dest "\}"
-    dumpputs $method $dest ""
-
     return
 }
 
 
-proc loadCfg { cfg } {
-    global nodes links
-    global showIfNames showIfIPaddrs showNodeLabels showLinkLabels
-
-    # Cleanup first - this also automatically deletes all associated links
-    foreach node $nodes {
-       removeGUINode $node
-    }
+proc redo {} {
+    global undolevel redolevel undolog oper_mode
 
-    set class ""
-    set object ""
-    foreach entry $cfg {
-       if {"$class" == ""} {
-           set class $entry
-           continue
-       } elseif {"$object" == ""} {
-           set object $entry
-           global $object
-           if {"$class" == "node"} {
-               lappend nodes $object
-           }
-           if {"$class" == "link"} {
-               lappend links $object
-           }
-           if {"$class" == "option"} {
-                # for future use
-               lappend prefs $object
-           }
-           continue
-       } else {
-           set line [concat $entry]
-           while {[llength $line] >= 2} {
-               set field [lindex $line 0]
-               if {"$field" == ""} {
-                   set line [lreplace $line 0 0]
-                   continue
-               }
-               set value [lindex $line 1]
-               set line [lreplace $line 0 1]
-               if {"$class" == "node"} {
-                   switch -exact -- $field {
-                       type {
-                           lappend $object "type $value"
-                       }
-                       model {
-                           lappend $object "model $value"
-                       }
-                       cpu {
-                           lappend $object "cpu {$value}"
-                       }
-                       interface-peer {
-                           lappend $object "interface-peer {$value}"
-                       }
-                       network-config {
-                           set cfg ""
-                           foreach zline [split $value {\r}] {
-                               if { [string index "$zline" 0] == "     " } {
-                                   set zline [string replace "$zline" 0 0]
-                                   lappend cfg $zline
-                               }
-                           }
-                           lappend $object "network-config {$cfg}"
-                       }
-                       custom-enabled {
-                           lappend $object "custom-enabled {$value}"
-                       }
-                       custom-command {
-                           lappend $object "custom-command {$value}"
-                       }
-                       custom-config {
-                           set cfg ""
-                           foreach zline [split $value {\r}] {
-                               if { [string index "$zline" 0] == "     " } {
-                                   set zline [string replace "$zline" 0 0]
-                                   lappend cfg $zline
-                               }
-                           }
-                           lappend $object "custom-config {$cfg}"
-                       }
-                       iconcoords {
-                           lappend $object "iconcoords {$value}"
-                       }
-                       labelcoords {
-                           lappend $object "labelcoords {$value}"
-                       }
-                   }
-               } elseif {"$class" == "link"} {
-                   switch -exact -- $field {
-                       nodes {
-                           lappend $object "nodes {$value}"
-                       }
-                       bandwidth {
-                           lappend $object "bandwidth $value"
-                       }
-                       delay {
-                           lappend $object "delay $value"
-                       }
-                       ber {
-                           lappend $object "ber $value"
-                       }
-                       duplicate {
-                           lappend $object "duplicate $value"
-                       }
-                   }
-               } elseif {"$class" == "option"} {
-                   switch -exact -- $field {
-                       interface_names {
-                            if { $value == "no" } {
-                                set showIfNames 0
-                            } elseif { $value == "yes" } {
-                                set showIfNames 1
-                            }
-                       }
-                       ip_addresses {
-                            if { $value == "no" } {
-                                set showIfIPaddrs 0
-                            } elseif { $value == "yes" } {
-                                set showIfIPaddrs 1
-                            }
-                       }
-                       node_labels {
-                            if { $value == "no" } {
-                                set showNodeLabels 0
-                            } elseif { $value == "yes" } {
-                                set showNodeLabels 1
-                            }
-                       }
-                       link_labels {
-                            if { $value == "no" } {
-                                set showLinkLabels 0
-                            } elseif { $value == "yes" } {
-                                set showLinkLabels 1
-                            }
-                       }
-                   }
-                }
-           }
-       }
-       set class ""
-       set object ""
+    if {$oper_mode == "edit" && $redolevel > $undolevel} {
+       incr undolevel
+       loadCfg $undolog($undolevel)
+       redrawAll
     }
     return
 }
 
 
+
 proc redrawAll {} {
     global nodes links
 
@@ -377,25 +179,6 @@ proc drawLink {link} {
 }
 
 
-proc newObjectId { type } {
-    global nodes links
-    
-    set mark [string range [set type] 0 0]
-    set id 0
-    while {[lsearch [set [set type]s] "$mark$id"]  != -1} {
-       incr id
-    }
-    return $mark$id
-}
-
-
-proc newIfc { type node } {
-    set interfaces [ifcList $node]
-    for { set id 0 } { [lsearch -exact $interfaces $type$id] >= 0 } {incr id} {}
-    return $type$id
-}
-
-
 proc chooseIfName { lnode1 lnode2 } {
     global $lnode1 $lnode2
 
@@ -418,7 +201,7 @@ proc chooseIfName { lnode1 lnode2 } {
        router {
            if { [nodeType $lnode2] == "router" || \
                [nodeType $lnode2] == "frswitch" } {
-               return ser
+               #return ser
                return eth
            } else {
                return eth
@@ -665,7 +448,7 @@ proc startethereal { c } {
 
 
 proc button1 { c x y button} {
-    global nodes
+    global nodes curcanvas
     global activetool newlink curobj changed def_router_model
     global router pc host lanswitch frswitch rj45 hub
     global lastX lastY
@@ -735,6 +518,7 @@ proc button1 { c x y button} {
            }
            lappend $node "network-config [list $nconfig]"
            lappend nodes $node
+           setNodeCanvas $node $curcanvas
            setNodeCoords $node "$x $y"
            set dy 32
            if { [lsearch {router hub lanswitch rj45} $activetool] >= 0 } {

diff --git a/imunes.tcl b/imunes.tcl
index 24d02824f0899d4c5029124d4c51a1aa0276b900..0b50a2602b1c22a2301b190d93a9fd2805eb1d7f 100755 (executable)
--- a/imunes.tcl
+++ b/imunes.tcl
@@ -56,10 +56,9 @@ source "$ROOTDIR/$LIBDIR/linkcfg.tcl"
 source "$ROOTDIR/$LIBDIR/nodecfg.tcl"
 source "$ROOTDIR/$LIBDIR/ipv4.tcl"
 source "$ROOTDIR/$LIBDIR/ipv6.tcl"
-source "$ROOTDIR/$LIBDIR/editor.tcl"
-source "$ROOTDIR/$LIBDIR/help.tcl"
-source "$ROOTDIR/$LIBDIR/filemgmt.tcl"
+source "$ROOTDIR/$LIBDIR/cfgparse.tcl"
 source "$ROOTDIR/$LIBDIR/exec.tcl"
+source "$ROOTDIR/$LIBDIR/canvas.tcl"
 
 source "$ROOTDIR/$LIBDIR/quagga.tcl"
 source "$ROOTDIR/$LIBDIR/xorp.tcl"
@@ -70,6 +69,10 @@ source "$ROOTDIR/$LIBDIR/hub.tcl"
 source "$ROOTDIR/$LIBDIR/lanswitch.tcl"
 source "$ROOTDIR/$LIBDIR/rj45.tcl"
 
+source "$ROOTDIR/$LIBDIR/editor.tcl"
+source "$ROOTDIR/$LIBDIR/help.tcl"
+source "$ROOTDIR/$LIBDIR/filemgmt.tcl"
+
 
 #
 # Global variables are initialized here
@@ -80,6 +83,8 @@ set eid e0
 set nodes {}
 set links {}
 set prefs {}
+set canvass {}
+newCanvas default
 
 set newlink ""
 set selectbox ""
@@ -96,6 +101,8 @@ set oper_mode edit
 set grid 24
 set sizex 1024
 set sizey 768
+set curcanvas [lindex $canvass 0]
+puts $curcanvas
 
 # Some default values
 set defLinkColor red

diff --git a/initgui.tcl b/initgui.tcl
index c175efb010d295850ae18519019ec030a64e6ac9..d630f3000e3186cc0d51e25d7173049a74cd3492 100755 (executable)
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -47,7 +47,7 @@ menu .menubar
 
 .menubar add cascade -label File -underline 0 -menu .menubar.file
 .menubar add cascade -label Edit -underline 0 -menu .menubar.edit
-.menubar add cascade -label Sheet -underline 0 -menu .menubar.sheet
+.menubar add cascade -label Canvas -underline 0 -menu .menubar.canvas
 .menubar add cascade -label View -underline 0 -menu .menubar.view
 .menubar add cascade -label Experiment -underline 1 -menu .menubar.experiment
 .menubar add cascade -label Help -underline 0 -menu .menubar.help
@@ -112,9 +112,9 @@ bind . <Control-y> redo
 
 
 #
-# Sheet
+# Canvas
 #
-menu .menubar.sheet -tearoff 0
+menu .menubar.canvas -tearoff 0
 
 
 #

diff --git a/install.sh b/install.sh
index d2d2e2f979adf8c6e10a19c962d056027525ffb0..a883daf342ef7152df2199f5acc3d1748233e385 100755 (executable)
--- a/install.sh
+++ b/install.sh
@@ -20,12 +20,14 @@ sed -e "s,LIBDIR=\"\",LIBDIR=$LIBDIR," \
     -e "s,ROOTDIR=\".\",ROOTDIR=$ROOTDIR," \
     -e "s,BINDIR=\".\",BINDIR=$BINDIR," \
     imunes > $ROOTDIR/$BINDIR/imunes
-chmod 755  $ROOTDIR/$BINDIR/imunes
+chmod 755 $ROOTDIR/$BINDIR/imunes
 
 
-lib_files="editor.tcl exec.tcl filemgmt.tcl nodecfg.tcl linkcfg.tcl help.tcl \
-          initgui.tcl quagga.tcl xorp.tcl static.tcl pc.tcl host.tcl \
-          ipv4.tcl ipv6.tcl lanswitch.tcl rj45.tcl hub.tcl quaggaboot.sh" 
+lib_files="nodecfg.tcl linkcfg.tcl cfgparse.tcl ipv4.tcl ipv6.tcl exec.tcl \
+          canvas.tcl editor.tcl filemgmt.tcl help.tcl initgui.tcl \
+          quagga.tcl xorp.tcl static.tcl pc.tcl host.tcl \
+          lanswitch.tcl rj45.tcl hub.tcl \
+          quaggaboot.sh" 
 
 tiny_icons="delete.gif hub.gif frswitch.gif host.gif \
            lanswitch.gif link.gif pc.gif rj45.gif router.gif select.gif"

diff --git a/nodecfg.tcl b/nodecfg.tcl
index 5aa20c5db88155f9de1e23fdbd522569d613980d..0a15f30e966a993bc9ef494067eaf2c1f4ae002e 100755 (executable)
--- a/nodecfg.tcl
+++ b/nodecfg.tcl
@@ -159,6 +159,12 @@
 # setNodeModel { node_id model }
 #      Sets the node's optional model identifyer.
 #
+# getNodeCanvas { node_id }
+#      Returns node's canvas affinity.
+#
+# setNodeCanvas { node_id canvas_id }
+#      Sets the node's canvas affinity.
+#
 # getNodeCoords { node_id }
 #      Return icon coords.
 #
@@ -768,30 +774,28 @@ proc removeNode { node } {
 }
 
 
-#
-# The following should really go into a separate "editing" library
-# XXX GUI / tk polluted!
-#
-
-proc undo {} {
-    global undolevel undolog oper_mode
+proc getNodeCanvas { node } {
+    global $node
 
-    if {$oper_mode == "edit" && $undolevel > 0} {
-       incr undolevel -1
-       loadCfg $undolog($undolevel)
-       redrawAll
-    }
-    return
+    return [lindex [lsearch -inline [set $node] "canvas *"] 1]
 }
 
 
-proc redo {} {
-    global undolevel redolevel undolog oper_mode
+proc setNodeCanvas { node canvas } {
+    global $node
 
-    if {$oper_mode == "edit" && $redolevel > $undolevel} {
-       incr undolevel
-       loadCfg $undolog($undolevel)
-       redrawAll
+    set i [lsearch [set $node] "canvas *"]
+    if { $i >= 0 } {
+       set $node [lreplace [set $node] $i $i "canvas $canvas"]
+    } else {
+       set $node [linsert [set $node] end "canvas $canvas"]
     }
     return
 }
+
+
+proc newIfc { type node } {
+    set interfaces [ifcList $node]
+    for { set id 0 } { [lsearch -exact $interfaces $type$id] >= 0 } {incr id} {}
+    return $type$id
+}