Deprecate / remove the "delete" icon. Deleting nodes / links can now be

performed through the right-button-menu; alternatively, selected nodes
can be deleted using the keyboard shortcut (delete key).

NOTE: this and previous patch have slightly broken the "undo" functionality,
we will deal with this later when cross-canvas linking code will be
completed.

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

diff --git a/editor.tcl b/editor.tcl
index af01351f32dc19f5c7fd28fb490ea63a6ca2346d..d882e105ce9e7819d980de17b8a35266d5996bb3 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -429,12 +429,53 @@ proc selectNode { c obj } {
 }
 
 
-proc button3 { c x y } {
+proc button3link { c x y } {
+    global oper_mode env eid canvas_list node_list
+
+    set link [lindex [$c gettags {link && current}] 1]
+    if { $link == "" } {
+       set link [lindex [$c gettags {linklabel && current}] 1]
+       if { $link == "" } {
+           return
+       }
+    }
+
+    .button3menu delete 0 end
+
+    #
+    # Configure link
+    #
+    .button3menu add command -label "Configure" \
+       -command "popupConfigDialog $c"
+
+    #
+    # Delete link
+    #
+    if { $oper_mode != "exec" } {
+       .button3menu add command -label "Delete" \
+           -command "removeGUILink $link"
+    } else {
+       .button3menu add command -label "Delete" \
+           -command "removeGUILink $link" -state disabled
+    }
+
+    set x [winfo pointerx .]
+    set y [winfo pointery .]
+    tk_popup .button3menu $x $y
+
+    return
+}
+
+
+proc button3node { c x y } {
     global oper_mode env eid canvas_list node_list
 
     set node [lindex [$c gettags {node && current}] 1]
     if { $node == "" } {
-       return
+       set node [lindex [$c gettags {nodelabel && current}] 1]
+       if { $node == "" } {
+           return
+       }
     }
 
     .button3menu delete 0 end
@@ -469,7 +510,8 @@ proc button3 { c x y } {
        if { $node != $peer_node } {
            set canvas [getNodeCanvas $peer_node]
            .button3menu.connect.$canvas add command \
-               -label [getNodeName $peer_node]
+               -label [getNodeName $peer_node] \
+               -command "newLink $c $node $peer_node"
        }
     }
 
@@ -549,7 +591,7 @@ proc startethereal { node iface } {
 }
 
 
-proc button1 { c x y button} {
+proc button1 { c x y button } {
     global node_list curcanvas
     global activetool newlink curobj changed def_router_model
     global router pc host lanswitch frswitch rj45 hub
@@ -564,31 +606,29 @@ proc button1 { c x y button} {
 
     set curobj [$c find withtag current]
     set curtype [lindex [$c gettags current] 0]
-    if {$curtype == "node"} {
+    if { $curtype == "node" } {
        set node [lindex [$c gettags {node && current}] 1]
        set wasselected \
            [expr [lsearch [$c find withtag "selected"] $curobj] > -1]
-       if {$button == "ctrl"} {
+       if { $button == "ctrl" } {
            if {$wasselected} {
                $c dtag $node selected
                $c delete -withtags "selectmark && $node"
            }
-       } elseif {!$wasselected} {
+       } elseif { !$wasselected } {
            $c dtag node selected
            $c delete -withtags selectmark
        }
-       if {($activetool == "select" || $activetool == "delete") && \
-         !$wasselected} {
+       if { $activetool == "select" && !$wasselected } {
            $c delete -withtags "selectmark && $node"
            selectNode $c $curobj
        }
-    } elseif {$button != "ctrl" || \
-      ($activetool != "select" && $activetool != "delete") } {
+    } elseif { $button != "ctrl" || $activetool != "select" } {
        $c dtag node selected
        $c delete -withtags selectmark
     }
-    if {$curobj == $background} {
-       if { [lsearch {select delete link} $activetool] < 0 } {
+    if { $curobj == $background } {
+       if { [lsearch {select link} $activetool] < 0 } {
            set node [newObjectId node]
            global $node
            lappend $node "type $activetool"
@@ -630,34 +670,19 @@ proc button1 { c x y button} {
            drawNode $node
            selectNode $c [$c find withtag "node && $node"]
            set changed 1
-       } elseif {($activetool == "select" || $activetool == "delete") \
+       } elseif { $activetool == "select" \
          && $curtype != "node" && $curtype != "nodelabel"} {
            $c config -cursor cross
            set lastX $x
            set lastY $y
            if {$selectbox != ""} {
                # We actually shouldn't get here!
+puts XXXX 1
                $c delete $selectbox
                set selectbox ""
            }
        }
     } else {
-       if {$activetool == "delete" && $curtype != "nodelabel"} {
-           set node [lindex [$c gettags {node && current}] 1]
-           set link [lindex [$c gettags {link && current}] 1]
-           if { $link == "" } {
-               set link [lindex [$c gettags {linklabel && current}] 1]
-           }
-           if { $link != "" } {
-               removeGUILink $link
-               set changed 1
-           } elseif { $node != "" } {
-               foreach obj [$c find withtag "node && selected"] {
-                   removeGUINode [lindex [$c gettags $obj] 1]
-               }
-               set changed 1
-           }
-       }
        if {$curtype == "node" || $curtype == "nodelabel"} {
            $c config -cursor fleur
        }
@@ -690,7 +715,7 @@ proc button1-motion { c x y } {
     set curtype [lindex [$c gettags current] 0]
     if {$activetool == "link" && $newlink != ""} {
        $c coords $newlink $lastX $lastY $x $y
-    } elseif {($activetool == "select" || $activetool == "delete") && \
+    } elseif {($activetool == "select" ) && \
       ( $curobj == $selectbox || $curobj == $background )} {
        if {$selectbox == ""} {
            set selectbox [$c create line \
@@ -728,13 +753,126 @@ proc button1-motion { c x y } {
 }
 
 
+proc newLink { c lnode1 lnode2 } {
+    global link_list
+    global $lnode1 $lnode2
+    global defEthBandwidth defSerBandwidth defSerDelay
+    global defLinkColor defLinkWidth
+
+    #
+    # We still do not support linking objects in different canvases.
+    #
+    if { [getNodeCanvas $lnode1] != [getNodeCanvas $lnode2] } {
+       return no
+    }
+
+    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
+       }
+
+    }
+
+    foreach link $link_list {
+       global $link
+       if { [$c find withtag "link && $lnode1 && $lnode2"] != "" } {
+           set regular no
+       }
+    }
+
+    if { $regular == "yes" } {
+       set link [newObjectId link]
+       global $link
+
+       set ipv4net [findFreeIPv4net 24]
+       set ipv6net [findFreeIPv6net 64]
+       set lannode ""
+
+       set ifname1 [newIfc [chooseIfName $lnode1 $lnode2] $lnode1]
+       lappend $lnode1 "interface-peer {$ifname1 $lnode2}"
+       if { [[typemodel $lnode1].layer] == "NETWORK" && \
+           [lsearch {lanswitch hub} [nodeType $lnode2]] >= 0 } {
+           setIfcIPv4addr $lnode1 $ifname1 [newLANIPv4 $lnode1 $lnode2]
+           setIfcIPv6addr $lnode1 $ifname1 [newLANIPv6 $lnode1 $lnode2]
+           set lannode $lnode2
+       } elseif { [[typemodel $lnode1].layer] == "NETWORK" } {
+           setIfcIPv4addr $lnode1 $ifname1 $ipv4net.1/24
+           setIfcIPv6addr $lnode1 $ifname1 $ipv6net\::1/64
+           if { [nodeType $lnode1] == "pc" || \
+               [nodeType $lnode1] == "host" } {
+               setStatIPv4routes $lnode1 [list "0.0.0.0/0 $ipv4net.2"]
+           }
+       }
+
+       set ifname2 [newIfc [chooseIfName $lnode2 $lnode1] $lnode2]
+       lappend $lnode2 "interface-peer {$ifname2 $lnode1}"
+       if { [[typemodel $lnode2].layer] == "NETWORK" && \
+           [lsearch {lanswitch hub} [nodeType $lnode1]] >= 0 } {
+           setIfcIPv4addr $lnode2 $ifname2 [newLANIPv4 $lnode2 $lnode1]
+           setIfcIPv6addr $lnode2 $ifname2 [newLANIPv6 $lnode2 $lnode1]
+           set lannode $lnode1
+       } elseif { [[typemodel $lnode2].layer] == "NETWORK" } {
+           setIfcIPv4addr $lnode2 $ifname2 $ipv4net.2/24
+           setIfcIPv6addr $lnode2 $ifname2 $ipv6net\::2/64
+           if { [nodeType $lnode2] == "pc" || \
+               [nodeType $lnode2] == "host" } {
+               setStatIPv4routes $lnode2 [list "0.0.0.0/0 $ipv4net.1"]
+           }
+       }
+
+       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
+       drawLink $link
+       updateLinkLabel $link
+       if { $lannode != "" } {
+           updateLANdg $lannode
+       }
+       nodeEnter $c
+       redrawLink $link
+    }
+
+    return $regular
+}
+
+
 proc button1-release { c x y } {
-    global link_list node_list
+    global node_list
     global activetool newlink curobj grid
     global changed undolog undolevel redolevel selectbox selected
     global lastX lastY sizex sizey
-    global defLinkColor defLinkWidth
-    global defEthBandwidth defSerBandwidth defSerDelay
     global autorearrange_enabled
 
     set x [$c canvasx $x]
@@ -743,6 +881,7 @@ proc button1-release { c x y } {
     $c config -cursor left_ptr
     if {$activetool == "link" && $newlink != ""} {
        $c delete $newlink
+       set newlink ""
        set destobj ""
        foreach obj [$c find overlapping $x $y $x $y] {
            if {[lindex [$c gettags $obj] 0] == "node"} {
@@ -751,110 +890,12 @@ proc button1-release { c x y } {
            }
        }
        if {$destobj != "" && $curobj != "" && $destobj != $curobj} {
-           set regular yes
            set lnode1 [lindex [$c gettags $curobj] 1]
            set lnode2 [lindex [$c gettags $destobj] 1]
-           global $lnode1 $lnode2
-           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
-               }
-               
-           }
-
-           foreach link $link_list {
-               global $link
-               if { [$c find withtag "link && $lnode1 && $lnode2"] != "" } {
-                   set regular no
-               }
-           }
-
-           set x [lindex [$c coords $destobj] 0]
-           set y [lindex [$c coords $destobj] 1]
-           if { $regular == "yes" } {
-               set link [newObjectId link]
-               global $link
-
-               set ipv4net [findFreeIPv4net 24]
-               set ipv6net [findFreeIPv6net 64]
-               set lannode ""
-
-               set ifname1 [newIfc [chooseIfName $lnode1 $lnode2] $lnode1]
-               lappend $lnode1 "interface-peer {$ifname1 $lnode2}"
-               if { [[typemodel $lnode1].layer] == "NETWORK" && \
-                   [lsearch {lanswitch hub} [nodeType $lnode2]] >= 0 } {
-                   setIfcIPv4addr $lnode1 $ifname1 [newLANIPv4 $lnode1 $lnode2]
-                   setIfcIPv6addr $lnode1 $ifname1 [newLANIPv6 $lnode1 $lnode2]
-                   set lannode $lnode2
-               } elseif { [[typemodel $lnode1].layer] == "NETWORK" } {
-                   setIfcIPv4addr $lnode1 $ifname1 $ipv4net.1/24
-                   setIfcIPv6addr $lnode1 $ifname1 $ipv6net\::1/64
-                   if { [nodeType $lnode1] == "pc" || \
-                       [nodeType $lnode1] == "host" } {
-                       setStatIPv4routes $lnode1 [list "0.0.0.0/0 $ipv4net.2"]
-                   }
-               }
-
-               set ifname2 [newIfc [chooseIfName $lnode2 $lnode1] $lnode2]
-               lappend $lnode2 "interface-peer {$ifname2 $lnode1}"
-               if { [[typemodel $lnode2].layer] == "NETWORK" && \
-                   [lsearch {lanswitch hub} [nodeType $lnode1]] >= 0 } {
-                   setIfcIPv4addr $lnode2 $ifname2 [newLANIPv4 $lnode2 $lnode1]
-                   setIfcIPv6addr $lnode2 $ifname2 [newLANIPv6 $lnode2 $lnode1]
-                   set lannode $lnode1
-               } elseif { [[typemodel $lnode2].layer] == "NETWORK" } {
-                   setIfcIPv4addr $lnode2 $ifname2 $ipv4net.2/24
-                   setIfcIPv6addr $lnode2 $ifname2 $ipv6net\::2/64
-                   if { [nodeType $lnode2] == "pc" || \
-                       [nodeType $lnode2] == "host" } {
-                       setStatIPv4routes $lnode2 [list "0.0.0.0/0 $ipv4net.1"]
-                   }
-               }
-
-               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
-               drawLink $link
-               updateLinkLabel $link
-               if { $lannode != "" } {
-                   updateLANdg $lannode
-               }
+           if { [newLink $c $lnode1 $lnode2] == "yes" } {
                set changed 1
-               nodeEnter $c
-
-               redrawLink $link
            }
        }
-       set newlink ""
     }
 
     if { $changed == 1 } {
@@ -909,7 +950,7 @@ proc button1-release { c x y } {
            set changed 0
        }
        $c dtag link need_redraw
-    } elseif {$activetool == "select" || $activetool == "delete"} {
+    } elseif {$activetool == "select" } {
        if {$selectbox == ""} {
            set x1 $x
            set y1 $y
@@ -963,9 +1004,6 @@ proc nodeEnter { c } {
        }
     }
     .bottom.textbox config -text "$line"
-    if {$activetool == "delete"} {
-       .c config -cursor pirate
-    }
     return
 }
 
@@ -979,9 +1017,6 @@ proc linkEnter {c} {
     }
     set line "$link: [getLinkBandwidthString $link] [getLinkDelayString $link]"
     .bottom.textbox config -text "$line"
-    if {$activetool == "delete"} {
-       .c config -cursor pirate
-    }
     return
 }
 
@@ -990,9 +1025,6 @@ proc anyLeave {c} {
     global activetool
 
     .bottom.textbox config -text ""
-    if {$activetool == "delete"} {
-       .c config -cursor left_ptr
-    }
     return
 }
 

diff --git a/exec.tcl b/exec.tcl
index 45f3af59392841825043cedd4987a53eeea1b7d0..82730c8493174a3f9d9770df343c43ac11859e8a 100755 (executable)
--- a/exec.tcl
+++ b/exec.tcl
@@ -62,7 +62,7 @@ proc setOperMode { mode } {
        }
     }
 
-    foreach b {delete link router hub lanswitch host pc rj45} {
+    foreach b {link router hub lanswitch host pc rj45} {
        if { "$mode" == "exec" } {
            .left.$b configure -state disabled
        } else {

diff --git a/initgui.tcl b/initgui.tcl
index 5af7a19d781089c408edba6f73a95a30bd139b86..0cb0cf891cb2c551cadf8d7d4d2ee601d8acb5de 100755 (executable)
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -258,7 +258,7 @@ menu .menubar.help -tearoff 0
 frame .left
 pack .left -side left -fill y
 
-foreach b {select delete link hub lanswitch router host pc rj45} {
+foreach b {select link hub lanswitch router host pc rj45} {
     set image [image create photo -file $ROOTDIR/$LIBDIR/icons/tiny/$b.gif]
     radiobutton .left.$b -indicatoron 0 \
        -variable activetool -value $b -selectcolor [.left cget -bg] \
@@ -310,9 +310,12 @@ $c bind node <Double-1> "popupConfigDialog $c"
 $c bind nodelabel <Double-1> "popupConfigDialog $c"
 $c bind link <Double-1> "popupConfigDialog $c"
 $c bind linklabel <Double-1> "popupConfigDialog $c"
+$c bind node <3> "button3node $c %x %y"
+$c bind nodelabel <3> "button3node $c %x %y"
+$c bind link <3> "button3link $c %x %y"
+$c bind linklabel <3> "button3link $c %x %y"
 bind $c <1> "button1 $c %x %y none"
 bind $c <Control-Button-1> "button1 $c %x %y ctrl"
-bind $c <3> "button3 $c %x %y"
 bind $c <B1-Motion> "button1-motion $c %x %y"
 bind $c <B1-ButtonRelease> "button1-release $c %x %y"
 bind . <Delete> "delete_object $c %x %y"