From: marko <marko>
Date: Thu, 3 Jan 2008 13:47:54 +0000 (+0000)
Subject: Initial implementation of an editing clipboard: introduce
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=39f008860bc8068299fb867d317cb0c121f8e8b5;p=imunes.git

Initial implementation of an editing clipboard: introduce
cut, copy and paste functions, and hook them up to the common
keyboard shortcuts CTRL+X, CTRL+C and CTRL+V.

So far the new functions operate only on proper nodes and links,
but not on annotations.

The clipboard is stored in ::cf::clipboard namespace, which must
never be used for any other purpose.

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

diff --git a/copypaste.tcl b/copypaste.tcl
new file mode 100644
index 0000000..062687f
--- /dev/null
+++ b/copypaste.tcl
@@ -0,0 +1,131 @@
+#
+# Copyright 2008 University of Zagreb, Croatia.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in the
+#    documentation and/or other materials provided with the distribution.
+#
+# THIS SOFTWARE IS PROVIDED BY AUTHOR AND CONTRIBUTORS ``AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+# ARE DISCLAIMED.  IN NO EVENT SHALL AUTHOR OR CONTRIBUTORS BE LIABLE
+# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+#
+
+# $Id: copypaste.tcl,v 1.1 2008/01/03 13:47:54 marko Exp $
+
+
+proc cutSelection {} {
+    copySelection
+    deleteSelection
+}
+
+
+proc copySelection {} {
+    global curcfg
+
+    catch { namespace delete ::cf::clipboard }
+    namespace eval ::cf::clipboard {}
+    upvar 0 ::cf::clipboard::node_list node_list
+    upvar 0 ::cf::clipboard::link_list link_list
+
+    # Copy selected nodes and interconnecting links to the clipboard
+    set node_list [selectedRealNodes]
+    set link_list {}
+    foreach node $node_list {
+	set ::cf::clipboard::$node [set ::cf::[set ::curcfg]::$node]
+	foreach ifc [ifcList $node] {
+	    set peer [peerByIfc $node $ifc]
+	    if { [lsearch $node_list $peer] < 0 } {
+		continue
+	    }
+	    set link [linkByPeers $node $peer]
+	    if { [lsearch $link_list $link] >= 0 } {
+		continue
+	    }
+	    lappend link_list $link
+	    set ::cf::clipboard::$link [set ::cf::[set ::curcfg]::$link]
+	}
+    }
+
+    # Prune stale interface data from copied nodes
+    set savedcurcfg $curcfg
+    set curcfg clipboard
+    foreach node $node_list {
+        upvar 0 ::cf::[set ::curcfg]::$node $node
+
+	foreach ifc [ifcList $node] {
+	    set peer [peerByIfc $node $ifc]
+	    if { [lsearch $node_list $peer] < 0 } {
+		netconfClearSection $node "interface $ifc"
+		set i [lsearch [set $node] "interface-peer {$ifc $peer}"]
+		set $node [lreplace [set $node] $i $i]
+	    }
+	}
+    }
+    set curcfg $savedcurcfg
+}
+
+
+proc paste {} {
+    upvar 0 ::cf::[set ::curcfg]::node_list node_list
+    upvar 0 ::cf::[set ::curcfg]::link_list link_list
+    global curcanvas changed
+
+    # Nothing to do if clipboard is empty
+    if {[set ::cf::clipboard::node_list] == {}} {
+	return
+    }
+
+    # Paste nodes from the clipboard while renaming them
+    foreach node_orig [set ::cf::clipboard::node_list] {
+	set node_copy [newObjectId node]
+	set node_map($node_orig) $node_copy
+	upvar 0 ::cf::[set ::curcfg]::$node_copy $node_copy
+	set $node_copy [set ::cf::clipboard::$node_orig]
+	lappend node_list $node_copy
+	setNodeName $node_copy $node_copy
+	setNodeCanvas $node_copy $curcanvas
+    }
+
+    # Remap interface peerings to match new node names
+    foreach node_orig [set ::cf::clipboard::node_list] {
+	set node_copy $node_map($node_orig)
+	foreach ifc [ifcList $node_copy] {
+	    set old_peer [peerByIfc $node_copy $ifc]
+	    set i [lsearch [set $node_copy] "interface-peer {$ifc $old_peer}"]
+	    set $node_copy [lreplace [set $node_copy] $i $i \
+		"interface-peer {$ifc $node_map($old_peer)}"]
+	}
+    }
+
+    # Paste links from the clipboard while renaming them
+    foreach link_orig [set ::cf::clipboard::link_list] {
+	set link_copy [newObjectId link]
+	upvar 0 ::cf::[set ::curcfg]::$link_copy $link_copy
+	set $link_copy [set ::cf::clipboard::$link_orig]
+	lappend link_list $link_copy
+	set old_peers [linkPeers $link_copy]
+	set new_peers \
+	    "$node_map([lindex $old_peers 0]) $node_map([lindex $old_peers 1])"
+	set i [lsearch [set $link_copy] "nodes {$old_peers}"]
+	set $link_copy [lreplace [set $link_copy] $i $i "nodes {$new_peers}"]
+    }
+
+    set changed 1
+    updateUndoLog
+    redrawAll
+}
+
+
diff --git a/editor.tcl b/editor.tcl
index 105198e..c6432a8 100755
--- a/editor.tcl
+++ b/editor.tcl
@@ -26,7 +26,7 @@
 # and Technology through the research contract #IP-2003-143.
 #
 
-# $Id: editor.tcl,v 1.86 2008/01/02 12:08:46 marko Exp $
+# $Id: editor.tcl,v 1.87 2008/01/03 13:47:54 marko Exp $
 
 
 #****h* imunes/editor.tcl
@@ -2870,7 +2870,7 @@ proc printCanvas { w } {
 #   By calling this procedure all the selected nodes in imunes will 
 #   be deleted.
 #****
-proc deleteSelection { } {
+proc deleteSelection {} {
     global changed
     global background 
     global viewid
diff --git a/imunes.tcl b/imunes.tcl
index b21ad00..220d78a 100755
--- a/imunes.tcl
+++ b/imunes.tcl
@@ -26,7 +26,7 @@
 # and Technology through the research contract #IP-2003-143.
 #
 
-# $Id: imunes.tcl,v 1.32 2008/01/02 12:08:46 marko Exp $
+# $Id: imunes.tcl,v 1.33 2008/01/03 13:47:54 marko Exp $
 
 
 #****h* imunes/imunes.tcl
@@ -120,6 +120,7 @@ source "$ROOTDIR/$LIBDIR/lanswitch.tcl"
 source "$ROOTDIR/$LIBDIR/rj45.tcl"
 
 source "$ROOTDIR/$LIBDIR/editor.tcl"
+source "$ROOTDIR/$LIBDIR/copypaste.tcl"
 source "$ROOTDIR/$LIBDIR/annotations.tcl"
 
 source "$ROOTDIR/$LIBDIR/help.tcl"
@@ -140,8 +141,8 @@ source "$ROOTDIR/$LIBDIR/ns2imunes.tcl"
 #    this list is empty.
 #*****
 
+# Default configuration
 namespace eval cf::cfg0 {}
-
 set cf::cfg0::node_list {}
 set cf::cfg0::link_list {}
 set cf::cfg0::annotation_list {}
@@ -149,6 +150,11 @@ set cf::cfg0::canvas_list {}
 
 set curcfg cfg0
 
+# Clipboard
+namespace eval cf::clipboard {}
+set cf::clipboard::node_list {}
+set cf::clipboard::link_list {}
+
 #****v* imunes.tcl/exec_hosts
 # NAME
 #    exec_hosts -- list of remote hosts data lists
diff --git a/initgui.tcl b/initgui.tcl
index 666f903..003de40 100755
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -26,7 +26,7 @@
 # and Technology through the research contract #IP-2003-143.
 #
 
-# $Id: initgui.tcl,v 1.42 2008/01/02 12:08:46 marko Exp $
+# $Id: initgui.tcl,v 1.43 2008/01/03 13:47:54 marko Exp $
 
 
 #****h* imunes/initgui.tcl
@@ -229,6 +229,16 @@ bind . <Control-z> undo
     -accelerator "Ctrl+Y" -command redo -state disabled
 bind . <Control-y> redo
 .menubar.edit add separator
+.menubar.edit add command -label "Cut" -underline 0 \
+    -accelerator "Ctrl+X" -command undo -state disabled
+bind . <Control-x> cutSelection
+.menubar.edit add command -label "Copy" -underline 0 \
+    -accelerator "Ctrl+C" -command undo -state disabled
+bind . <Control-c> copySelection
+.menubar.edit add command -label "Paste" -underline 0 \
+    -accelerator "Ctrl+V" -command undo -state disabled
+bind . <Control-v> paste
+.menubar.edit add separator
 .menubar.edit add command -label "Select all" \
     -accelerator "Ctrl+A" -command {
 	foreach obj [.c find withtag node] {
diff --git a/install.sh b/install.sh
index c39b162..49058da 100755
--- a/install.sh
+++ b/install.sh
@@ -24,7 +24,7 @@ chmod 755 $ROOTDIR/$BINDIR/imunes
 
 lib_files="nodecfg.tcl linkcfg.tcl cfgparse.tcl ipv4.tcl ipv6.tcl exec.tcl \
 	   canvas.tcl editor.tcl filemgmt.tcl help.tcl initgui.tcl \
-	   quagga.tcl xorp.tcl static.tcl pc.tcl host.tcl \
+	   copypaste.tcl quagga.tcl xorp.tcl static.tcl pc.tcl host.tcl \
 	   lanswitch.tcl rj45.tcl hub.tcl ns2imunes.tcl ipsec.tcl \
 	   topogen.tcl annotations.tcl gpgui.tcl graph_partitioning.tcl"