--- /dev/null
+#
+# 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
+}
+
+
# 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
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"
# 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 {}
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
# 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
-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] {
projects / imunes.git / commitdiff