From: marko <marko>
Date: Mon, 24 Oct 2005 12:06:36 +0000 (+0000)
Subject: Deprecate / remove the "delete" icon.  Deleting nodes / links can now be
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=fd360ed9b10b078305207b2e8513b76204f36e50;p=imunes.git

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 af01351..d882e10 100755
--- 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 45f3af5..82730c8 100755
--- 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 5af7a19..0cb0cf8 100755
--- 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"