From: marko <marko>
Date: Mon, 7 Nov 2005 10:57:40 +0000 (+0000)
Subject: Implement link merging GUI operation for pseudo-links with both endpoints
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=a3e667ffe638b274dab8297ed75f6939d9d749a9;p=imunes.git

Implement link merging GUI operation for pseudo-links with both endpoints
residing in the current canvas.

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

diff --git a/editor.tcl b/editor.tcl
index adc8d1f..1166bdc 100755
--- a/editor.tcl
+++ b/editor.tcl
@@ -509,6 +509,7 @@ proc selectNode { c obj } {
 
 proc button3link { c x y } {
     global oper_mode env eid canvas_list node_list
+    global curcanvas
 
     set link [lindex [$c gettags {link && current}] 1]
     if { $link == "" } {
@@ -548,6 +549,19 @@ proc button3link { c x y } {
 	    -state disabled
     }
 
+    #
+    # Merge two pseudo nodes / links
+    #
+    if { $oper_mode != "exec" && [getLinkMirror $link] != "" &&
+	[getNodeCanvas [getNodeMirror [lindex [linkPeers $link] 1]]] ==
+	$curcanvas } {
+	.button3menu add command -label "Merge" \
+	    -command "mergeGUINode [lindex [linkPeers $link] 1]"
+    } else {
+	.button3menu add command -label "Merge" \
+	    -state disabled
+    }
+
     set x [winfo pointerx .]
     set y [winfo pointery .]
     tk_popup .button3menu $x $y
@@ -595,6 +609,14 @@ proc movetoCanvas { canvas } {
 }
 
 
+proc mergeGUINode { node } {
+    set link [lindex [linkByIfc $node [ifcList $node]] 0]
+puts $link
+    mergeLink $link
+    redrawAll
+}
+
+
 proc button3node { c x y } {
     global oper_mode env eid canvas_list node_list curcanvas
 
@@ -687,7 +709,7 @@ proc button3node { c x y } {
     #
     # Merge two pseudo nodes / links
     #
-    if { [nodeType $node] == "pseudo" && \
+    if { $oper_mode != "exec" && [nodeType $node] == "pseudo" && \
 	 [getNodeCanvas $mirror_node] == $curcanvas } {
 	.button3menu add command -label "Merge" \
 	    -command "mergeGUINode $node"
@@ -1038,6 +1060,7 @@ proc newLink { lnode1 lnode2 atomic } {
     if { $regular == "yes" } {
 	set link [newObjectId link]
 	global $link
+	set $link {}
 
 	set ifname1 [newIfc [chooseIfName $lnode1 $lnode2] $lnode1]
 	lappend $lnode1 "interface-peer {$ifname1 $lnode2}"
diff --git a/linkcfg.tcl b/linkcfg.tcl
index a10ca07..c1dd43c 100755
--- a/linkcfg.tcl
+++ b/linkcfg.tcl
@@ -316,10 +316,50 @@ proc splitLink { link nodetype } {
 
 
 proc mergeLink { link } {
+    global link_list node_list
 
     set mirror_link [getLinkMirror $link]
     if { $mirror_link == "" } {
 	puts "XXX mergeLink called for non-pseudo link!!!"
 	return
     }
+    set link1_peers [linkPeers $link]
+    set link2_peers [linkPeers $mirror_link]
+    set orig_node1 [lindex $link1_peers 0]
+    set orig_node2 [lindex $link2_peers 0]
+    set pseudo_node1 [lindex $link1_peers 1]
+    set pseudo_node2 [lindex $link2_peers 1]
+    set new_link [newObjectId link]
+    global $orig_node1 $orig_node2
+    global $new_link
+
+puts "$orig_node1 $orig_node2 $pseudo_node1 $pseudo_node2"
+    set ifc1 [ifcByPeer $orig_node1 $pseudo_node1]
+    set ifc2 [ifcByPeer $orig_node2 $pseudo_node2]
+    set i [lsearch [set $orig_node1] "interface-peer {* $pseudo_node2}"]
+    set $orig_node1 [lreplace [set $orig_node1] $i $i \
+			"interface-peer {$ifc1 $orig_node2}"]
+    set i [lsearch [set $orig_node2] "interface-peer {* $pseudo_node1}"]
+    set $orig_node2 [lreplace [set $orig_node2] $i $i \
+			"interface-peer {$ifc2 $orig_node1}"]
+
+    set $new_link {}
+    lappend $new_link "nodes {$orig_node1 $orig_node2}"
+
+    setLinkBandwidth $new_link [getLinkBandwidth $link]
+    setLinkDelay $new_link [getLinkDelay $link]
+    setLinkBER $new_link [getLinkBER $link]
+    setLinkDup $new_link [getLinkDup $link]
+
+    set i [lsearch -exact $link_list $link]
+    set link_list [lreplace $link_list $i $i]
+    set i [lsearch -exact $link_list $mirror_link]
+    set link_list [lreplace $link_list $i $i]
+    lappend link_list $new_link
+
+    set i [lsearch -exact $node_list $pseudo_node1]
+    set node_list [lreplace $node_list $i $i]
+    set i [lsearch -exact $node_list $pseudo_node2]
+    set node_list [lreplace $node_list $i $i]
+
 }