From: marko <marko>
Date: Tue, 8 Nov 2005 13:03:07 +0000 (+0000)
Subject: Rewrite of the "move to canvas" routine.
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=a3c53c49aa3c7ba451c7f2e02e13b27cb4346c07;p=imunes.git

Rewrite of the "move to canvas" routine.

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

diff --git a/editor.tcl b/editor.tcl
index d184cd9..222bf5f 100755
--- a/editor.tcl
+++ b/editor.tcl
@@ -122,6 +122,7 @@ proc undo {} {
     if {$oper_mode == "edit" && $undolevel > 0} {
 	incr undolevel -1
 	loadCfg $undolog($undolevel)
+	switchCanvas none
 	redrawAll
     }
     return
@@ -134,13 +135,13 @@ proc redo {} {
     if {$oper_mode == "edit" && $redolevel > $undolevel} {
 	incr undolevel
 	loadCfg $undolog($undolevel)
+	switchCanvas none
 	redrawAll
     }
     return
 }
 
 
-
 proc redrawAll {} {
     global node_list link_list background sizex sizey
     global curcanvas
@@ -168,7 +169,6 @@ proc redrawAll {} {
     }
 
     refreshCanvasMenu
-
     return
 }
 
@@ -212,7 +212,7 @@ proc drawNode { node } {
 }
 
 
-proc drawLink {link} {
+proc drawLink { link } {
     global defLinkWidth defLinkColor
 
     set nodes [linkPeers $link]
@@ -674,12 +674,12 @@ proc button3node { c x y } {
     }
     foreach peer_node $node_list {
 	set canvas [getNodeCanvas $peer_node]
-	if { $node != $peer_node &&
+	if { $node != $peer_node && [nodeType $node] != "rj45" &&
 	    [lsearch {pseudo rj45} [nodeType $peer_node]] < 0 &&
 	    [ifcByLogicalPeer $node $peer_node] == "" } {
 	    .button3menu.connect.$canvas add command \
 		-label [getNodeName $peer_node] \
-		-command "newLink $node $peer_node atomic"
+		-command "newGUILink $node $peer_node"
 	} elseif { [nodeType $peer_node] != "pseudo" } {
 	    .button3menu.connect.$canvas add command \
 		-label [getNodeName $peer_node] \
@@ -934,194 +934,33 @@ proc pseudo.layer {} {
 }
 
 
-proc newLink { lnode1 lnode2 atomic } {
-    global link_list
-    global $lnode1 $lnode2
-    global defEthBandwidth defSerBandwidth defSerDelay
-    global defLinkColor defLinkWidth
-    global curcanvas changed
-
-    #
-    # When linking nodes residing in different canvases, we actually
-    # have to create a connector-type pseudo-node in each canvas, and
-    # then recursively call newLink to connect requested nodes to those
-    # automatically created pseudo-nodes
-    #
-    if { [getNodeCanvas $lnode1] != [getNodeCanvas $lnode2] } {
-	set pnode1 [newNode pseudo]
-	setNodeCanvas $pnode1 [getNodeCanvas $lnode1]
-	setNodeName $pnode1 $lnode2
-	setNodeCoords $pnode1 [getNodeCoords $lnode2]
-	setNodeLabelCoords $pnode1 [getNodeCoords $lnode2]
-	if { [getNodeCanvas $lnode1] == $curcanvas } {
-	    drawNode $pnode1
-	}
-
-	set pnode2 [newNode pseudo]
-	setNodeCanvas $pnode2 [getNodeCanvas $lnode2]
-	setNodeName $pnode2 $lnode1
-	setNodeCoords $pnode2 [getNodeCoords $lnode1]
-	setNodeLabelCoords $pnode2 [getNodeCoords $lnode1]
-	if { [getNodeCanvas $lnode2] == $curcanvas } {
-	    drawNode $pnode2
-	}
-
-	setNodeMirror $pnode1 $pnode2
-	setNodeMirror $pnode2 $pnode1
-
-	newLink $lnode1 $pnode1 recursive
-	newLink $lnode2 $pnode2 recursive
-
-	set link1 [linkByPeers $lnode1 $pnode1]
-	set link2 [linkByPeers $lnode2 $pnode2]
-	setLinkMirror $link1 $link2
-	setLinkMirror $link2 $link1
-	
-	if {[[typemodel $lnode1].layer] == "NETWORK" } {
-	    set ifc1 [ifcByPeer $lnode1 $pnode1]
-	    autoIPv4addr $lnode1 $ifc1
-	    autoIPv6addr $lnode1 $ifc1
-	}
-	if {[[typemodel $lnode2].layer] == "NETWORK" } {
-	    set ifc2 [ifcByPeer $lnode2 $pnode2]
-	    autoIPv4addr $lnode2 $ifc2
-	    autoIPv6addr $lnode2 $ifc2
-	}
-	if {[[typemodel $lnode1].layer] == "NETWORK" &&
-	    [nodeType $lnode1] != "router" } {
-	    set ifc1 [ifcByPeer $lnode1 $pnode1]
-	    autoIPv4defaultroute $lnode1 $ifc1
-	    autoIPv6defaultroute $lnode1 $ifc1
-	}
-	if {[[typemodel $lnode2].layer] == "NETWORK" &&
-	    [nodeType $lnode2] != "router" } {
-	    set ifc2 [ifcByPeer $lnode2 $pnode2]
-	    autoIPv4defaultroute $lnode2 $ifc2
-	    autoIPv6defaultroute $lnode2 $ifc2
-	}
-
-	#
-	# Redraw our node so interface labels gets properly populated
-	#
-	if { [getNodeCanvas $lnode1] == $curcanvas } {
-	    .c delete -withtags "node && $pnode1"
-	    .c delete -withtags "nodelabel && $pnode1"
-	    drawNode $pnode1
-	    updateIfcLabel $lnode1 $pnode1
-	} else {
-	    .c delete -withtags "node && $pnode2"
-	    .c delete -withtags "nodelabel && $pnode2"
-	    drawNode $pnode2
-	    updateIfcLabel $lnode2 $pnode2
-	}
-
-	if { $atomic == "atomic" } {
-	    set changed 1
-	    updateUndoLog
-	}
-	return yes
-    }
-
-    set regular yes
-
-    if { [nodeType $lnode1] == "frswitch" && \
-	[nodeType $lnode2] != "router" && \
-	[nodeType $lnode2] != "frswitch" } { set regular no }
-    if { [nodeType $lnode2] == "frswitch" && \
-	[nodeType $lnode1] != "router" && \
-	[nodeType $lnode1] != "frswitch" } { set regular no }
-    if { [nodeType $lnode1] == "hub" && \
-	[nodeType $lnode2] == "hub" } { set regular no }
-    if { [nodeType $lnode1] == "rj45" || \
-	[nodeType $lnode2] == "rj45" } {
-	if { [nodeType $lnode1] == "rj45" } {
-	    set rj45node $lnode1
-	    set othernode $lnode2
-	} else {
-	    set rj45node $lnode2
-	    set othernode $lnode1
-	}
-	if { [lsearch {router lanswitch hub pc host} \
-	  [nodeType $othernode]] < 0} {
-	    set regular no
-	}
-	if { [lsearch [set $rj45node] "interface-peer *"] > 0 } {
-	    set regular no
-	}
-
-    }
+proc newGUILink { lnode1 lnode2 } {
+    global changed
 
-    foreach link $link_list {
-	#
-	# XXX what is this -> makes no sense / cannot work!
-	#
-	global $link
-	if { [.c find withtag "link && $lnode1 && $lnode2"] != "" } {
-	    set regular no
-	}
+    set link [newLink $lnode1 $lnode2]
+    if { $link == "" } {
+	return
     }
-
-    if { $regular == "yes" } {
-	set link [newObjectId link]
-	global $link
-	set $link {}
-
-	set ifname1 [newIfc [chooseIfName $lnode1 $lnode2] $lnode1]
-	lappend $lnode1 "interface-peer {$ifname1 $lnode2}"
-	set ifname2 [newIfc [chooseIfName $lnode2 $lnode1] $lnode2]
-	lappend $lnode2 "interface-peer {$ifname2 $lnode1}"
-
-	lappend $link "nodes {$lnode1 $lnode2}"
-	if { ([nodeType $lnode1] == "lanswitch" || \
-	    [nodeType $lnode2] == "lanswitch" || \
-	    [string first eth "$ifname1 $ifname2"] != -1) && \
-	    [nodeType $lnode1] != "rj45" && \
-	    [nodeType $lnode2] != "rj45" } {
-	    lappend $link "bandwidth $defEthBandwidth"
-	} elseif { [string first ser "$ifname1 $ifname2"] != -1 } {
-	    lappend $link "bandwidth $defSerBandwidth"
-	    lappend $link "delay $defSerDelay"
-	}
-
-	lappend link_list $link
-
-	if { [nodeType $lnode2] != "pseudo" &&
-	    [[typemodel $lnode1].layer] == "NETWORK" } {
-	    autoIPv4addr $lnode1 $ifname1
-	    autoIPv6addr $lnode1 $ifname1
-	}
-	if { [nodeType $lnode1] != "pseudo" &&
-	    [[typemodel $lnode2].layer] == "NETWORK" } {
-	    autoIPv4addr $lnode2 $ifname2
-	    autoIPv6addr $lnode2 $ifname2
-	}
-	if { [nodeType $lnode1] != "router" &&
-	    [nodeType $lnode2] != "pseudo" &&
-	    [[typemodel $lnode1].layer] == "NETWORK" } {
-	    autoIPv4defaultroute $lnode1 $ifname1
-	    autoIPv6defaultroute $lnode1 $ifname1
-	}
-	if { [nodeType $lnode2] != "router" &&
-	    [nodeType $lnode1] != "pseudo" &&
-	    [[typemodel $lnode2].layer] == "NETWORK" } {
-	    autoIPv4defaultroute $lnode2 $ifname2
-	    autoIPv6defaultroute $lnode2 $ifname2
-	}
-
-	if { [getNodeCanvas $lnode1] == $curcanvas } {
-	    drawLink $link
-	    updateLinkLabel $link
-	    nodeEnter .c
-	    redrawLink $link
-	}
-
-	if { $atomic == "atomic" } {
-	    set changed 1
-	    updateUndoLog
-	}
+    if { [getNodeCanvas $lnode1] != [getNodeCanvas $lnode2] } {
+	set new_nodes [splitLink $link pseudo]
+	set orig_nodes [linkPeers $link]
+	set new_node1 [lindex $new_nodes 0]
+	set new_node2 [lindex $new_nodes 1]
+	set orig_node1 [lindex $orig_nodes 0]
+	set orig_node2 [lindex $orig_nodes 1]
+	set new_link1 [linkByPeers $orig_node1 $new_node1]
+	set new_link2 [linkByPeers $orig_node2 $new_node2]
+	setNodeMirror $new_node1 $new_node2
+	setNodeMirror $new_node2 $new_node1
+	setNodeName $new_node1 $orig_node2
+	setNodeName $new_node2 $orig_node1
+	setLinkMirror $new_link1 $new_link2
+	setLinkMirror $new_link2 $new_link1
     }
-
-    return $regular
+    redrawAll
+    set changed 1
+    updateUndoLog
+    return
 }
 
 
@@ -1149,15 +988,21 @@ proc button1-release { c x y } {
 	if {$destobj != "" && $curobj != "" && $destobj != $curobj} {
 	    set lnode1 [lindex [$c gettags $curobj] 1]
 	    set lnode2 [lindex [$c gettags $destobj] 1]
-	    if { [newLink $lnode1 $lnode2 non-atomic] == "yes" } {
-		set changed 1
+	    if { [ifcByLogicalPeer $lnode1 $lnode2] == "" } {
+		set link [newLink $lnode1 $lnode2]
+		if { $link != "" } {
+		    drawLink $link
+		    redrawLink $link
+		    updateLinkLabel $link
+		    set changed 1
+		}
 	    }
 	}
     }
 
     if { $changed == 1 } {
 	set regular true
-	if {[lindex [$c gettags $curobj] 0] == "nodelabel"} {
+	if { [lindex [$c gettags $curobj] 0] == "nodelabel" } {
 	    set node [lindex [$c gettags $curobj] 1]
 	    selectNode $c [$c find withtag "node && $node"]
 	}
@@ -1764,7 +1609,6 @@ proc popupConfigApply { wi object_type target close phase } {
 	    set name [string trim [$wi.ftop.name get]]
 	    if { $name != [getNodeName $target] } {
 		setNodeName $target $name
-		.c itemconfigure "nodelabel && $target" -text $name
 		set changed 1
 	    }
 	    if { $oper_mode == "edit" && $type == "router" && \
@@ -1811,7 +1655,6 @@ proc popupConfigApply { wi object_type target close phase } {
 		    set oldifoperstate [getIfcOperState $target $ifc]
 		    if { $ifoperstate != $oldifoperstate } {
 			setIfcOperState $target $ifc $ifoperstate
-			updateIfcLabel $target [peerByIfc $target $ifc]
 			set changed 1
 		    }
 
@@ -1822,14 +1665,12 @@ proc popupConfigApply { wi object_type target close phase } {
 		    set oldipaddr [getIfcIPv4addr $target $ifc]
 		    if { $ipaddr != $oldipaddr } {
 			setIfcIPv4addr $target $ifc $ipaddr
-			updateIfcLabel $target [peerByIfc $target $ifc]
 			set changed 1
 		    }
 		    set ipaddr [$wi.if$ifc.cfg.ipv6.addrv get]
 		    set oldipaddr [getIfcIPv6addr $target $ifc]
 		    if { $ipaddr != $oldipaddr } {
 			setIfcIPv6addr $target $ifc $ipaddr
-			updateIfcLabel $target [peerByIfc $target $ifc]
 			set changed 1
 		    }
 
@@ -1954,9 +1795,11 @@ proc popupConfigApply { wi object_type target close phase } {
 		}
 		set changed 1
 	    }
-	    updateLinkLabel $target
 	}
     }
+    if { $changed == 1 } {
+	redrawAll
+    }
     updateUndoLog
     if { $close == "close" } {
 	destroy $wi
@@ -2172,18 +2015,44 @@ proc switchCanvas { direction } {
 	    }
 	}
     }
+
+    .hframe.t delete all
+    set x 0
+    foreach canvas $canvas_list {
+	set text [.hframe.t create text 0 0 \
+	    -text "[getCanvasName $canvas]" -tags "text $canvas"]
+	set ox [lindex [.hframe.t bbox $text] 2]
+	set oy [lindex [.hframe.t bbox $text] 3]
+	set tab [.hframe.t create polygon $x 0 [expr $x + 7] 18 \
+	    [expr $x + 2 * $ox + 17] 18 [expr $x + 2 * $ox + 24] 0 $x 0 \
+	    -fill gray -tags "tab $canvas"]
+	set line [.hframe.t create line 0 0 $x 0 [expr $x + 7] 18 \
+	    [expr $x + 2 * $ox + 17] 18 [expr $x + 2 * $ox + 24] 0 999 0 \
+	    -fill #808080 -width 2 -tags "line $canvas"]
+	.hframe.t coords $text [expr $x + $ox + 12] [expr $oy + 2]
+	.hframe.t raise $text
+	incr x [expr 2 * $ox + 17]
+    }
+    .hframe.t raise "$curcanvas"
+    .hframe.t itemconfigure "tab && $curcanvas" -fill #e0e0e0
+
     redrawAll
     return
 }
 
 
 proc renameCanvasApply { w } {
-    global curcanvas
+    global curcanvas changed
 
     set newname [$w.e1 get]
     destroy $w
+    if { $newname != [getCanvasName $curcanvas] } {
+	set changed 1
+    }
     setCanvasName $curcanvas $newname
     refreshCanvasMenu
+    switchCanvas none
+    updateUndoLog
 }
 
 
@@ -2229,8 +2098,8 @@ proc refreshCanvasMenu {} {
         }
         deleteSelection
         set i [lsearch $canvas_list $curcanvas]
-        switchCanvas next
         set canvas_list [lreplace $canvas_list $i $i]
+        switchCanvas none
         set changed 1
         updateUndoLog
         refreshCanvasMenu
@@ -2243,7 +2112,7 @@ proc refreshCanvasMenu {} {
     .menubar.canvas add separator
     foreach canvas $canvas_list {
 	.menubar.canvas add radiobutton -label [getCanvasName $canvas] \
-		-command redrawAll -indicatoron true \
+		-command "switchCanvas none" -indicatoron true \
 		-value $canvas -variable curcanvas
     }
     return
diff --git a/initgui.tcl b/initgui.tcl
index 1c9370a..f089907 100755
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -290,7 +290,7 @@ set c [canvas .c -bd 0 -relief sunken -highlightthickness 0\
 	-scrollregion "-32 -32 [expr $sizex + 32] [expr $sizey + 32]" \
 	-xscrollcommand ".hframe.scroll set" \
 	-yscrollcommand ".vframe.scroll set"]
-canvas .hframe.t -width 250 -height 18 -bd 0 -highlightthickness 0 \
+canvas .hframe.t -width 300 -height 18 -bd 0 -highlightthickness 0 \
 	-background gray
 scrollbar .hframe.scroll -orient horiz -command "$c xview" \
 	-bd 1 -width 14
diff --git a/linkcfg.tcl b/linkcfg.tcl
index c7a2ade..5ada454 100755
--- a/linkcfg.tcl
+++ b/linkcfg.tcl
@@ -361,4 +361,88 @@ proc mergeLink { link } {
     set i [lsearch -exact $node_list $pseudo_node2]
     set node_list [lreplace $node_list $i $i]
 
+    return $new_link
+}
+
+
+proc newLink { lnode1 lnode2 } {
+    global link_list
+    global $lnode1 $lnode2
+    global defEthBandwidth defSerBandwidth defSerDelay
+    global defLinkColor defLinkWidth
+    global curcanvas
+
+    if { [nodeType $lnode1] == "frswitch" && \
+	[nodeType $lnode2] != "router" && \
+	[nodeType $lnode2] != "frswitch" } { set regular no }
+    if { [nodeType $lnode2] == "frswitch" && \
+	[nodeType $lnode1] != "router" && \
+	[nodeType $lnode1] != "frswitch" } { set regular no }
+    if { [nodeType $lnode1] == "hub" && \
+	[nodeType $lnode2] == "hub" } { set regular no }
+    if { [nodeType $lnode1] == "rj45" || \
+	[nodeType $lnode2] == "rj45" } {
+	if { [nodeType $lnode1] == "rj45" } {
+	    set rj45node $lnode1
+	    set othernode $lnode2
+	} else {
+	    set rj45node $lnode2
+	    set othernode $lnode1
+	}
+	if { [lsearch {router lanswitch hub pc host} \
+	  [nodeType $othernode]] < 0} {
+	    return
+	}
+	if { [lsearch [set $rj45node] "interface-peer *"] > 0 } {
+	    return
+	}
+    }
+
+    set link [newObjectId link]
+    global $link
+    set $link {}
+
+    set ifname1 [newIfc [chooseIfName $lnode1 $lnode2] $lnode1]
+    lappend $lnode1 "interface-peer {$ifname1 $lnode2}"
+    set ifname2 [newIfc [chooseIfName $lnode2 $lnode1] $lnode2]
+    lappend $lnode2 "interface-peer {$ifname2 $lnode1}"
+
+    lappend $link "nodes {$lnode1 $lnode2}"
+    if { ([nodeType $lnode1] == "lanswitch" || \
+	[nodeType $lnode2] == "lanswitch" || \
+	[string first eth "$ifname1 $ifname2"] != -1) && \
+	[nodeType $lnode1] != "rj45" && \
+	[nodeType $lnode2] != "rj45" } {
+	lappend $link "bandwidth $defEthBandwidth"
+    } elseif { [string first ser "$ifname1 $ifname2"] != -1 } {
+	lappend $link "bandwidth $defSerBandwidth"
+	lappend $link "delay $defSerDelay"
+    }
+
+    lappend link_list $link
+
+    if { [nodeType $lnode2] != "pseudo" &&
+	[[typemodel $lnode1].layer] == "NETWORK" } {
+	autoIPv4addr $lnode1 $ifname1
+	autoIPv6addr $lnode1 $ifname1
+    }
+    if { [nodeType $lnode1] != "pseudo" &&
+	[[typemodel $lnode2].layer] == "NETWORK" } {
+	autoIPv4addr $lnode2 $ifname2
+	autoIPv6addr $lnode2 $ifname2
+    }
+    if { [nodeType $lnode1] != "router" &&
+	[nodeType $lnode2] != "pseudo" &&
+	[[typemodel $lnode1].layer] == "NETWORK" } {
+	autoIPv4defaultroute $lnode1 $ifname1
+	autoIPv6defaultroute $lnode1 $ifname1
+    }
+    if { [nodeType $lnode2] != "router" &&
+	[nodeType $lnode1] != "pseudo" &&
+	[[typemodel $lnode2].layer] == "NETWORK" } {
+	autoIPv4defaultroute $lnode2 $ifname2
+	autoIPv6defaultroute $lnode2 $ifname2
+    }
+
+    return $link
 }