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 adc8d1f7999c2c0f3a36a7585c1415e86bfd0bd5..1166bdc3f238530337d68d592bdf614214d2d665 100755 (executable)
--- 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 a10ca07c9032e17ff96d06f522c72e3f70d01009..c1dd43cb94f8ee7f868631041dd70bf7644f1257 100755 (executable)
--- 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]
+
 }