Implement initial GUI support for operating on multiple canvases.

TODO: implement links that can bind nodes in different canvases.

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

diff --git a/canvas.tcl b/canvas.tcl
index 802e59276ad0cc81fb739e188479398d765f2d3d..cbbb07f9ecf7b2e31d7ea9f03dc98f6a91a06f3c 100755 (executable)
--- a/canvas.tcl
+++ b/canvas.tcl
@@ -32,21 +32,28 @@
 
 
 proc removeCanvas { canvas } {
-    global canvass $canvas
+    global canvas_list $canvas
 
-    set i [lsearch $canvass $canvas]
-    set canvass [lreplace $canvass $i $i]
+    set i [lsearch $canvas_list $canvas]
+    set canvas_list [lreplace $canvas_list $i $i]
     set $canvas {}
     return
 }
 
 
 proc newCanvas { name } {
-    global canvass
+    global canvas_list
 
-    set canvas c0
+    set canvas [newObjectId canvas]
     global $canvas
-    lappend canvass $canvas
-    set $canvas {name default}
+    lappend canvas_list $canvas
+    set $canvas [list "name $name"]
     return
 }
+
+
+proc getCanvasName { canvas } {
+    global $canvas
+
+    return [lrange [lsearch -inline [set $canvas] "name *"] 1 end]
+}

diff --git a/cfgparse.tcl b/cfgparse.tcl
index 61133a1a835fc6a2e0e3ae127dd1e2b146b0e18c..3eda1bd63777149c02c1d1a1e3a301008620cecc 100755 (executable)
--- a/cfgparse.tcl
+++ b/cfgparse.tcl
@@ -49,11 +49,11 @@ proc dumpputs {method dest string} {
 
 
 proc dumpCfg {method dest} {
-    global nodes links canvass
+    global node_list link_list canvas_list
     global showIfNames showNodeLabels showLinkLabels
     global showIfIPaddrs showIfIPv6addrs
 
-    foreach node $nodes {
+    foreach node $node_list {
        global $node
        upvar 0 $node lnode
        dumpputs $method $dest "node $node \{"
@@ -78,7 +78,7 @@ proc dumpCfg {method dest} {
        dumpputs $method $dest ""
     }
 
-    foreach link $links {
+    foreach link $link_list {
        global $link
        upvar 0 $link llink
        dumpputs $method $dest "link $link \{"
@@ -89,7 +89,7 @@ proc dumpCfg {method dest} {
        dumpputs $method $dest ""
     }
 
-    foreach canvas $canvass {
+    foreach canvas $canvas_list {
        global $canvas
        upvar 0 $canvas lcanvas
        dumpputs $method $dest "canvas $canvas \{"
@@ -129,16 +129,15 @@ proc dumpCfg {method dest} {
 
 
 proc loadCfg { cfg } {
-    global nodes links canvass
+    global node_list link_list canvas_list
     global showIfNames showNodeLabels showLinkLabels
     global showIfIPaddrs showIfIPv6addrs
 
     # Cleanup first - this also automatically deletes all associated links
-    # XXX remove this - Tk polution!
-    foreach node $nodes {
-       removeGUINode $node
+    foreach node $node_list {
+       removeNode $node
     }
-    foreach canvas $canvass {
+    foreach canvas $canvas_list {
        removeCanvas $canvas
     }
 
@@ -152,13 +151,13 @@ proc loadCfg { cfg } {
            set object $entry
            global $object
            if {"$class" == "node"} {
-               lappend nodes $object
+               lappend node_list $object
            }
            if {"$class" == "link"} {
-               lappend links $object
+               lappend link_list $object
            }
            if {"$class" == "canvas"} {
-               lappend canvass $object
+               lappend canvas_list $object
            }
            if {"$class" == "option"} {
                 # for future use
@@ -300,11 +299,11 @@ proc loadCfg { cfg } {
 
 
 proc newObjectId { type } {
-    global nodes links canvass
+    global node_list link_list canvas_list
 
     set mark [string range [set type] 0 0]
     set id 0
-    while {[lsearch [set [set type]s] "$mark$id"]  != -1} {
+    while {[lsearch [set [set type]_list] "$mark$id"]  != -1} {
         incr id
     }
     return $mark$id

diff --git a/editor.tcl b/editor.tcl
index 072e596e3c6327eeb8e8d17ab6e5a786acffa21e..ccadcbdaa422e6b8fb2542362f915c5bd248959d 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -120,16 +120,33 @@ proc redo {} {
 
 
 proc redrawAll {} {
-    global nodes links
+    global node_list link_list background sizex sizey
+    global curcanvas
 
-    foreach node $nodes {
-       drawNode $node
+    .c delete all
+    set background [.c create rectangle 0 0 $sizex $sizey \
+       -fill white -tags "background"]
+    .c lower $background
+
+    foreach node $node_list {
+       if { [getNodeCanvas $node] == $curcanvas } {
+           drawNode $node
+       }
     }
-    foreach link $links {
+
+    foreach link $link_list {
+       set nodes [linkPeers $link]
+       if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
+            [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
+           continue
+       }
        drawLink $link
        redrawLink $link
        updateLinkLabel $link
     }
+
+    refreshCanvasMenu
+
     return
 }
 
@@ -337,9 +354,14 @@ proc updateLinkLabel { link } {
 
 
 proc redrawAllLinks {} {
-    global links
+    global link_list curcanvas
 
-    foreach link $links {
+    foreach link $link_list {
+       set nodes [linkPeers $link]
+       if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
+            [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
+           continue
+       }
        redrawLink $link
     }
     return
@@ -411,8 +433,8 @@ proc button3 { c x y } {
     global oper_mode env eid
 
     set node [lindex [$c gettags {node && current}] 1]
-    set node_id $eid\_$node
     if { $node != "" && $oper_mode == "exec" } {
+       set node_id $eid\_$node
        set cmd [[typemodel $node].shellcmd $node]
        if { $cmd != "" } {
            nexec xterm -sb -rightbar \
@@ -448,7 +470,7 @@ proc startethereal { c } {
 
 
 proc button1 { c x y button} {
-    global nodes curcanvas
+    global node_list curcanvas
     global activetool newlink curobj changed def_router_model
     global router pc host lanswitch frswitch rj45 hub
     global lastX lastY
@@ -517,7 +539,7 @@ proc button1 { c x y button} {
                        ! ]
            }
            lappend $node "network-config [list $nconfig]"
-           lappend nodes $node
+           lappend node_list $node
            setNodeCanvas $node $curcanvas
            setNodeCoords $node "$x $y"
            set dy 32
@@ -627,7 +649,7 @@ proc button1-motion { c x y } {
 
 
 proc button1-release { c x y } {
-    global links nodes
+    global link_list node_list
     global activetool newlink curobj grid
     global changed undolog undolevel redolevel selectbox selected
     global lastX lastY sizex sizey
@@ -680,7 +702,7 @@ proc button1-release { c x y } {
                
            }
 
-           foreach link $links {
+           foreach link $link_list {
                global $link
                if { [$c find withtag "link && $lnode1 && $lnode2"] != "" } {
                    set regular no
@@ -740,7 +762,7 @@ proc button1-release { c x y } {
                    lappend $link "bandwidth $defSerBandwidth"
                    lappend $link "delay $defSerDelay"
                }
-               lappend links $link
+               lappend link_list $link
                drawLink $link
                updateLinkLabel $link
                if { $lannode != "" } {
@@ -869,10 +891,10 @@ proc nodeEnter { c } {
 
 
 proc linkEnter {c} {
-    global activetool links
+    global activetool link_list
 
     set link [lindex [$c gettags current] 1]
-    if { [lsearch $links $link] == -1 } {
+    if { [lsearch $link_list $link] == -1 } {
        return
     }
     set line "$link: [getLinkBandwidthString $link] [getLinkDelayString $link]"
@@ -1586,7 +1608,7 @@ proc delete_object { c x y } {
 
 
 proc rearrange { mode } {
-    global nodes links autorearrange_enabled sizex sizey
+    global link_list autorearrange_enabled sizex sizey curcanvas
 
     set c .c
     set autorearrange_enabled 1
@@ -1674,7 +1696,12 @@ proc rearrange { mode } {
                set fy_t($other) [expr $fy_t($other) - $p_fy]
            }
 
-           foreach link $links {
+           foreach link $link_list {
+               set nodes [linkPeers $link]
+               if { [getNodeCanvas [lindex $nodes 0]] != $curcanvas ||
+                   [getNodeCanvas [lindex $nodes 1]] != $curcanvas } {
+                       continue
+               }
                set peers [linkPeers $link]
                set coords0 [getNodeCoords [lindex $peers 0]]
                set coords1 [getNodeCoords [lindex $peers 1]]
@@ -1731,3 +1758,14 @@ proc rearrange { mode } {
     .bottom.mbuf config -text ""
 }
 
+
+proc refreshCanvasMenu {} {
+    global canvas_list curcanvas
+
+    .menubar.canvas delete 0 end
+    foreach canvas $canvas_list {
+       .menubar.canvas add radiobutton -label [getCanvasName $canvas] \
+               -command redrawAll -indicatoron true \
+               -value $canvas -variable curcanvas
+    }
+}

diff --git a/exec.tcl b/exec.tcl
index 4d2c0fb4be66095b0fb255c3411bffbc8b231e8a..45f3af59392841825043cedd4987a53eeea1b7d0 100755 (executable)
--- a/exec.tcl
+++ b/exec.tcl
@@ -40,7 +40,7 @@ proc nexec { args } {
 
 
 proc setOperMode { mode } {
-    global oper_mode activetool nodes
+    global oper_mode activetool node_list
     global nmbufs nmbclusters
 
     # Verify that links to external interfaces are properly configured
@@ -48,7 +48,7 @@ proc setOperMode { mode } {
        set extifcs [nexec ifconfig -l]
        set extifcs \
            [lreplace $extifcs [lsearch $extifcs lo0] [lsearch $extifcs lo0]]
-       foreach node $nodes {
+       foreach node $node_list {
            if { [nodeType $node] == "rj45" } {
                set i [lsearch $extifcs [getNodeName $node]]
                if { $i < 0 } {
@@ -198,7 +198,7 @@ proc l3node.nghook { eid node ifc } {
 
 proc deployCfg {} {
     global eid
-    global nodes links supp_router_models
+    global node_list link_list supp_router_models
     global mac_byte4 mac_byte5
 
     set mac_byte4 0
@@ -213,7 +213,7 @@ proc deployCfg {} {
     catch { nexec kldload ng_iface }
     catch { nexec kldload ng_eiface }
 
-    foreach node $nodes {
+    foreach node $node_list {
        set node_id "$eid\_$node"
        set type [nodeType $node]
        set name [getNodeName $node]
@@ -221,7 +221,7 @@ proc deployCfg {} {
        [typemodel $node].instantiate $eid $node
     }
 
-    foreach link $links {
+    foreach link $link_list {
        statline "Creating link $link"
        set lnode1 [lindex [linkPeers $link] 0]
        set lnode2 [lindex [linkPeers $link] 1]
@@ -278,7 +278,7 @@ proc deployCfg {} {
        catch { nexec cp /dev/null /usr/local/etc/quagga/$file }
     }
 
-    foreach node $nodes {
+    foreach node $node_list {
        global $node
        statline "Configuring node [getNodeName $node]"
        set node_id "$eid\_$node"
@@ -313,7 +313,7 @@ proc deployCfg {} {
        }
     }
 
-    statline "Network topology instantiated in [expr [clock seconds] - $t_start] seconds ([llength $nodes] nodes and [llength $links] links)."
+    statline "Network topology instantiated in [expr [clock seconds] - $t_start] seconds ([llength $node_list] nodes and [llength $link_list] links)."
 }
 
 
@@ -377,10 +377,10 @@ proc monitor_loop {} {
 
 
 proc linkByIfc { node ifc } {
-    global links
+    global link_list
 
     set peer [peerByIfc $node $ifc]
-    foreach link $links {
+    foreach link $link_list {
        set endpoints [linkPeers $link]
        if { $endpoints == "$node $peer" } {
            set dir downstream

diff --git a/imunes.tcl b/imunes.tcl
index 4408aaed87b75878a8fdb18d3a88ea40ea461872..7aac88d6f065dfa10dcb84b74386b769463303e5 100755 (executable)
--- a/imunes.tcl
+++ b/imunes.tcl
@@ -77,47 +77,11 @@ source "$ROOTDIR/$LIBDIR/filemgmt.tcl"
 #
 # Global variables are initialized here
 #
-
-set eid e0
-
-set nodes {}
-set links {}
+set node_list {}
+set link_list {}
+set canvas_list {}
 set prefs {}
-set canvass {}
-newCanvas default
-
-set newlink ""
-set selectbox ""
-set selected ""
-
-set undolevel 0
-set redolevel 0
-set undolog(0) ""
-set changed 0
-set badentry 0
-set cursorState 0
-set clock_seconds 0
-set oper_mode edit
-set grid 24
-set sizex 1024
-set sizey 768
-set curcanvas [lindex $canvass 0]
-set autorearrange_enabled 0
-
-# Some default values
-set defLinkColor red
-set defLinkWidth 2
-set defEthBandwidth 100000000
-set defSerBandwidth 2048000
-set defSerDelay 2500
-set showIfNames 1
-set showIfIPaddrs 1
-set showIfIPv6addrs 1
-set showNodeLabels 1
-set showLinkLabels 1
-
-set supp_router_models "xorp quagga static"
-set def_router_model quagga
+set eid e0
 
 
 #

diff --git a/initgui.tcl b/initgui.tcl
index bfba130eae03a10f71be423f272c972e70843002..75f14e49726a84db78cf76072516c2c16730d3d8 100755 (executable)
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -34,11 +34,52 @@
 #
 
 
+#
+# GUI-related global variables
+#
+
+set newlink ""
+set selectbox ""
+set selected ""
+newCanvas default
+
+set undolevel 0
+set redolevel 0
+set undolog(0) ""
+set changed 0
+set badentry 0
+set cursorState 0
+set clock_seconds 0
+set oper_mode edit
+set grid 24
+set sizex 1024
+set sizey 768
+set curcanvas [lindex $canvas_list 0]
+set autorearrange_enabled 0
+
+#
+# Initialize a few variables to default values
+#
+set defLinkColor red
+set defLinkWidth 2
+set defEthBandwidth 100000000
+set defSerBandwidth 2048000
+set defSerDelay 2500
+set showIfNames 1
+set showIfIPaddrs 1
+set showIfIPv6addrs 1
+set showNodeLabels 1
+set showLinkLabels 1
+
+set supp_router_models "xorp quagga static"
+set def_router_model quagga
+
+
 #
 # Window / canvas setup section
 #
 
-wm minsize . 640 480
+wm minsize . 640 400
 wm geometry . 800x600
 wm title . IMUNES
 
@@ -47,7 +88,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 Canvas -underline 0 -menu .menubar.canvas
+.menubar add cascade -label Canvas -underline 0 -menu .menubar.canvas
 .menubar add cascade -label Tools -underline 0 -menu .menubar.tools
 .menubar add cascade -label View -underline 0 -menu .menubar.view
 .menubar add cascade -label Experiment -underline 1 -menu .menubar.experiment
@@ -110,6 +151,12 @@ bind . <Control-z> undo
 .menubar.edit add command -label "Redo" -underline 0 \
     -accelerator "Ctrl+Y" -command redo
 bind . <Control-y> redo
+.menubar.edit add separator
+.menubar.edit add command -label "New canvas" -underline 0 \
+    -command {
+       newCanvas unnamed
+       refreshCanvasMenu
+    }
 
 
 #
@@ -223,9 +270,6 @@ frame .grid
 set c [canvas .c -relief sunken -bd 1 \
        -scrollregion "-32 -32 [expr $sizex + 32] [expr $sizey + 32]" \
        -xscrollcommand ".hscroll set" -yscrollcommand ".vscroll set"]
-set background [.c create rectangle 0 0 $sizex $sizey \
-       -fill white -tags "background"]
-.c lower $background
 scrollbar .hscroll -orient horiz -command "$c xview"
 scrollbar .vscroll -command "$c yview"
 pack .grid -expand yes -fill both -padx 0 -pady 0
@@ -261,9 +305,7 @@ $c bind linklabel <Any-Leave> "anyLeave $c"
 $c bind node <Double-1> "popupConfigDialog $c"
 $c bind nodelabel <Double-1> "popupConfigDialog $c"
 $c bind link <Double-1> "popupConfigDialog $c"
-#$c bind link <Double-3> "startethereal $c"
 $c bind link <B3-ButtonRelease> "startethereal $c"
-#$c bind linklabel <Double-3> "startethereal $c"
 $c bind linklabel <B3-ButtonRelease> "startethereal $c"
 $c bind linklabel <Double-1> "popupConfigDialog $c"
 bind $c <1> "button1 $c %x %y none"
@@ -280,3 +322,9 @@ bind $c <B2-Motion> "$c scan dragto %x %y 1"
 bind $c <4> "$c yview scroll 1 units"
 bind $c <5> "$c yview scroll -1 units"
 
+
+#
+# Done with initialization, draw an empty canvas
+#
+refreshCanvasMenu
+redrawAll

diff --git a/ipv4.tcl b/ipv4.tcl
index 8679a93550765c97a51b002bd4ea89ce5a65cf94..b4b63fd97648ff9bef7fcac7e6af255036c1b580 100755 (executable)
--- a/ipv4.tcl
+++ b/ipv4.tcl
@@ -35,10 +35,10 @@
 
 
 proc findFreeIPv4net { mask } {
-    global nodes
+    global node_list
 
     set ipnets {}
-    foreach node $nodes {
+    foreach node $node_list {
         foreach ifc [ifcList $node] {
             set ipnet [lrange [split [getIfcIPv4addr $node $ifc] .] 0 2]
             if {[lsearch $ipnets $ipnet] == -1} {

diff --git a/ipv6.tcl b/ipv6.tcl
index 909609a2af291661a4c88abc909c360e36297431..cf102c367594ff53b74bb3215168cd96e0f7d915 100755 (executable)
--- a/ipv6.tcl
+++ b/ipv6.tcl
@@ -35,10 +35,10 @@
 
 
 proc findFreeIPv6net { mask } {
-    global nodes
+    global node_list
 
     set ipnets {}
-    foreach node $nodes {
+    foreach node $node_list {
         foreach ifc [ifcList $node] {
             set ipnet [lrange [split [getIfcIPv6addr $node $ifc] :] 0 3]
             if {[lsearch $ipnets $ipnet] == -1} {

diff --git a/linkcfg.tcl b/linkcfg.tcl
index 24beed9919b8812451d0e956772e1abb269bc03b..b694efb757fef8cde331eaee979e216cc6cb65ca 100755 (executable)
--- a/linkcfg.tcl
+++ b/linkcfg.tcl
@@ -78,9 +78,9 @@ proc linkPeers { link } {
 
 
 proc linkByPeers { node1 node2 } {
-    global links
+    global link_list
 
-    foreach link $links {
+    foreach link $link_list {
        set peers [linkPeers $link]
        if { $peers == "$node1 $node2" || $peers == "$node2 $node1" } {
            return $link
@@ -91,7 +91,7 @@ proc linkByPeers { node1 node2 } {
 
 
 proc removeLink { link } {
-    global links $link
+    global link_list $link
 
     set pnodes [linkPeers $link]
     foreach node $pnodes {
@@ -104,8 +104,8 @@ proc removeLink { link } {
         set $node [lreplace [set $node] $i $i]
     }
     unset $link
-    set i [lsearch -exact $links $link]
-    set links [lreplace $links $i $i]
+    set i [lsearch -exact $link_list $link]
+    set link_list [lreplace $link_list $i $i]
     return
 }
 

diff --git a/nodecfg.tcl b/nodecfg.tcl
index 0a15f30e966a993bc9ef494067eaf2c1f4ae002e..696e6fd7d84ad26475fb0c7c1b379fbaa43ba6d4 100755 (executable)
--- a/nodecfg.tcl
+++ b/nodecfg.tcl
@@ -760,7 +760,7 @@ proc hasIPv6Addr { node } {
 
 
 proc removeNode { node } {
-    global nodes $node
+    global node_list $node
 
     foreach ifc [ifcList $node] {
         set peer [peerByIfc $node $ifc]
@@ -768,8 +768,8 @@ proc removeNode { node } {
         removeLink $link
     }
     unset $node
-    set i [lsearch -exact $nodes $node]
-    set nodes [lreplace $nodes $i $i]
+    set i [lsearch -exact $node_list $node]
+    set node_list [lreplace $node_list $i $i]
     return
 }