From: marko <marko>
Date: Wed, 2 Nov 2005 07:57:23 +0000 (+0000)
Subject: Fix several instances of undo not properly logging recent changes.
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=3bfa5fd336d6c412cf4e5365670770caf7277981;p=imunes.git

Fix several instances of undo not properly logging recent changes.

Implement browsing through canvases via PgUp / PgDown or menu.

Canvases can now be deleted.

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

diff --git a/editor.tcl b/editor.tcl
index 596a1e0..e7bda33 100755
--- a/editor.tcl
+++ b/editor.tcl
@@ -55,8 +55,8 @@ proc animateCursor {} {
 }
 
 
-proc removeGUILink { link } {
-    global .c
+proc removeGUILink { link atomic } {
+    global changed
 
     set nodes [linkPeers $link]
     set node1 [lindex $nodes 0]
@@ -77,18 +77,20 @@ proc removeGUILink { link } {
 	removeLink $link
     }
     .c delete $link
+    if { $atomic == "atomic" } {
+	set changed 1
+	updateUndoLog
+    }
     return
 }
 
 
 proc removeGUINode { node } {
-    global .c
-
     set type [nodeType $node]
     foreach ifc [ifcList $node] {
 	set peer [peerByIfc $node $ifc]
 	set link [lindex [.c gettags "link && $node && $peer"] 1]
-	removeGUILink $link
+	removeGUILink $link non-atomic
     }
     if { $type != "pseudo" } {
 	removeNode $node
@@ -400,7 +402,7 @@ proc redrawAllLinks {} {
 
 
 proc redrawLink { link } {
-    global .c $link
+    global $link
 
     set limages [.c find withtag "link && $link"]
     set limage1 [lindex $limages 0]
@@ -486,10 +488,10 @@ proc button3link { c x y } {
     #
     if { $oper_mode != "exec" } {
 	.button3menu add command -label "Delete" \
-	    -command "removeGUILink $link"
+	    -command "removeGUILink $link atomic"
     } else {
 	.button3menu add command -label "Delete" \
-	    -command "removeGUILink $link" -state disabled
+	    -state disabled
     }
 
     set x [winfo pointerx .]
@@ -551,7 +553,7 @@ proc button3node { c x y } {
 	    [ifcByLogicalPeer $node $peer_node] == "" } {
 	    .button3menu.connect.$canvas add command \
 		-label [getNodeName $peer_node] \
-		-command "newLink $c $node $peer_node"
+		-command "newLink $node $peer_node atomic"
 	} elseif { [nodeType $peer_node] != "pseudo" } {
 	    .button3menu.connect.$canvas add command \
 		-label [getNodeName $peer_node] \
@@ -564,10 +566,10 @@ proc button3node { c x y } {
     #
     if { $oper_mode != "exec" } {
 	.button3menu add command -label "Delete" \
-	    -command "delete_object $c $x $y"
+	    -command deleteSelection
     } else {
 	.button3menu add command -label "Delete" \
-	    -command "delete_object $c $x $y" -state disabled
+	    -state disabled
     }
 
     #
@@ -773,12 +775,12 @@ proc pseudo.layer {} {
 }
 
 
-proc newLink { c lnode1 lnode2 } {
+proc newLink { lnode1 lnode2 atomic } {
     global link_list
     global $lnode1 $lnode2
     global defEthBandwidth defSerBandwidth defSerDelay
     global defLinkColor defLinkWidth
-    global curcanvas
+    global curcanvas changed
 
     #
     # When linking nodes residing in different canvases, we actually
@@ -790,8 +792,8 @@ proc newLink { c lnode1 lnode2 } {
 	set pnode1 [newNode pseudo]
 	setNodeCanvas $pnode1 [getNodeCanvas $lnode1]
 	setNodeName $pnode1 $lnode2
-	setNodeCoords $pnode1 "100 100"
-	setNodeLabelCoords $pnode1 "100 100"
+	setNodeCoords $pnode1 [getNodeCoords $lnode2]
+	setNodeLabelCoords $pnode1 [getNodeCoords $lnode2]
 	if { [getNodeCanvas $lnode1] == $curcanvas } {
 	    drawNode $pnode1
 	}
@@ -799,8 +801,8 @@ proc newLink { c lnode1 lnode2 } {
 	set pnode2 [newNode pseudo]
 	setNodeCanvas $pnode2 [getNodeCanvas $lnode2]
 	setNodeName $pnode2 $lnode1
-	setNodeCoords $pnode2 "100 100"
-	setNodeLabelCoords $pnode2 "100 100"
+	setNodeCoords $pnode2 [getNodeCoords $lnode1]
+	setNodeLabelCoords $pnode2 [getNodeCoords $lnode1]
 	if { [getNodeCanvas $lnode2] == $curcanvas } {
 	    drawNode $pnode2
 	}
@@ -808,8 +810,8 @@ proc newLink { c lnode1 lnode2 } {
 	setNodeMirror $pnode1 $pnode2
 	setNodeMirror $pnode2 $pnode1
 
-	newLink $c $lnode1 $pnode1
-	newLink $c $lnode2 $pnode2
+	newLink $lnode1 $pnode1 recursive
+	newLink $lnode2 $pnode2 recursive
 
 	set link1 [linkByPeers $lnode1 $pnode1]
 	set link2 [linkByPeers $lnode2 $pnode2]
@@ -829,17 +831,21 @@ proc newLink { c lnode1 lnode2 } {
 	# Redraw our node so interface labels gets properly populated
 	#
 	if { [getNodeCanvas $lnode1] == $curcanvas } {
-	    $c delete -withtags "node && $pnode1"
-	    $c delete -withtags "nodelabel && $pnode1"
+	    .c delete -withtags "node && $pnode1"
+	    .c delete -withtags "nodelabel && $pnode1"
 	    drawNode $pnode1
 	    updateIfcLabel $lnode1 $pnode1
 	} else {
-	    $c delete -withtags "node && $pnode2"
-	    $c delete -withtags "nodelabel && $pnode2"
+	    .c delete -withtags "node && $pnode2"
+	    .c delete -withtags "nodelabel && $pnode2"
 	    drawNode $pnode2
 	    updateIfcLabel $lnode2 $pnode2
 	}
 
+	if { $atomic == "atomic" } {
+	    set changed 1
+	    updateUndoLog
+	}
 	return yes
     }
 
@@ -877,7 +883,7 @@ proc newLink { c lnode1 lnode2 } {
 	# XXX what is this -> makes no sense / cannot work!
 	#
 	global $link
-	if { [$c find withtag "link && $lnode1 && $lnode2"] != "" } {
+	if { [.c find withtag "link && $lnode1 && $lnode2"] != "" } {
 	    set regular no
 	}
     }
@@ -919,10 +925,14 @@ proc newLink { c lnode1 lnode2 } {
 	if { [getNodeCanvas $lnode1] == $curcanvas } {
 	    drawLink $link
 	    updateLinkLabel $link
-	    nodeEnter $c
+	    nodeEnter .c
 	    redrawLink $link
 	}
 
+	if { $atomic == "atomic" } {
+	    set changed 1
+	    updateUndoLog
+	}
     }
 
     return $regular
@@ -953,7 +963,7 @@ proc button1-release { c x y } {
 	if {$destobj != "" && $curobj != "" && $destobj != $curobj} {
 	    set lnode1 [lindex [$c gettags $curobj] 1]
 	    set lnode2 [lindex [$c gettags $destobj] 1]
-	    if { [newLink $c $lnode1 $lnode2] == "yes" } {
+	    if { [newLink $lnode1 $lnode2 non-atomic] == "yes" } {
 		set changed 1
 	    }
 	}
@@ -1778,32 +1788,22 @@ proc printCanvas { w } {
 }
 
 
-proc delete_object { c x y } {
+proc deleteSelection { } {
     global changed
     global background 
 
-    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
-    } 
-    if { $node != "" } {
-        removeGUINode $node 
-        set changed 1
-    }
-    foreach obj [$c find withtag "node && selected"] {
-        removeGUINode [lindex [$c gettags $obj] 1]
+    foreach obj [.c find withtag "node && selected"] {
+	set lnode [lindex [.c gettags $obj] 1]
+	if { $lnode != "" } {
+            removeGUINode $lnode
+	}
         set changed 1
     }
-    $c raise link background
-    $c raise linklabel "link || background"
-    $c raise interface "linklabel || link || background"
-    $c raise node "interface || linklabel || link || background"
-    $c raise nodelabel "node || interface || linklabel || link || background"
+    .c raise link background
+    .c raise linklabel "link || background"
+    .c raise interface "linklabel || link || background"
+    .c raise node "interface || linklabel || link || background"
+    .c raise nodelabel "node || interface || linklabel || link || background"
     updateUndoLog
 }
 
@@ -1811,7 +1811,6 @@ proc delete_object { c x y } {
 proc rearrange { mode } {
     global link_list autorearrange_enabled sizex sizey curcanvas
 
-    set c .c
     set autorearrange_enabled 1
     .menubar.tools entryconfigure "Rearrange all" -state disabled
     .menubar.tools entryconfigure "Rearrange selected" -state disabled
@@ -1834,11 +1833,11 @@ proc rearrange { mode } {
 	    set otime $ntime
 	}
 
-	set objects [$c find withtag $tagmatch]
-	set peer_objects [$c find withtag node]
+	set objects [.c find withtag $tagmatch]
+	set peer_objects [.c find withtag node]
 	foreach obj $peer_objects {
-            set node [lindex [$c gettags $obj] 1]
-	    set coords [$c coords $obj]
+            set node [lindex [.c gettags $obj] 1]
+	    set coords [.c coords $obj]
 	    set x [lindex $coords 0]
 	    set y [lindex $coords 1]
 	    set x_t($node) $x
@@ -1872,13 +1871,13 @@ proc rearrange { mode } {
 	}
 
 	foreach obj $objects {
-            set node [lindex [$c gettags $obj] 1]
+            set node [lindex [.c gettags $obj] 1]
 	    set i [lsearch -exact $peer_objects $obj]
 	    set peer_objects [lreplace $peer_objects $i $i]
 	    set x $x_t($node)
 	    set y $y_t($node)
 	    foreach other_obj $peer_objects {
-		set other [lindex [$c gettags $other_obj] 1]
+		set other [lindex [.c gettags $other_obj] 1]
 		set o_x $x_t($other)
 		set o_y $y_t($other)
 		set dx [expr $x - $o_x]
@@ -1920,7 +1919,7 @@ proc rearrange { mode } {
 	}
 
 	foreach obj $objects {
-            set node [lindex [$c gettags $obj] 1]
+            set node [lindex [.c gettags $obj] 1]
 	    if { [catch "set v_t($node)" v] } {
 		set vx 0.0
 		set vy 0.0
@@ -1940,23 +1939,51 @@ proc rearrange { mode } {
 	    set v_t($node) "$vx $vy"
 
 	    setNodeCoords $node "$x $y"
-	    $c move $obj $dx $dy
-	    set img [$c find withtag "selectmark && $node"]
-	    $c move $img $dx $dy
-	    set img [$c find withtag "nodelabel && $node"]
-	    $c move $img $dx $dy
-	    setNodeLabelCoords $node [$c coords $img]
-	    $c addtag need_redraw withtag "link && $node"
-	}
-	foreach link [$c find withtag "link && need_redraw"] {
-	    redrawLink [lindex [$c gettags $link] 1]
-	}
-	$c dtag link need_redraw
+	    .c move $obj $dx $dy
+	    set img [.c find withtag "selectmark && $node"]
+	    .c move $img $dx $dy
+	    set img [.c find withtag "nodelabel && $node"]
+	    .c move $img $dx $dy
+	    setNodeLabelCoords $node [.c coords $img]
+	    .c addtag need_redraw withtag "link && $node"
+	}
+	foreach link [.c find withtag "link && need_redraw"] {
+	    redrawLink [lindex [.c gettags $link] 1]
+	}
+	.c dtag link need_redraw
 	update
     }
     .menubar.tools entryconfigure "Rearrange all" -state normal
     .menubar.tools entryconfigure "Rearrange selected" -state normal
     .bottom.mbuf config -text ""
+    return
+}
+
+
+proc switchCanvas { direction } {
+    global canvas_list curcanvas
+
+    set i [lsearch $canvas_list $curcanvas]
+    switch -exact -- $direction {
+	prev {
+	    incr i -1
+	    if { $i < 0 } {
+		set curcanvas [lindex $canvas_list end]
+	    } else {
+		set curcanvas [lindex $canvas_list $i]
+	    }
+	}
+	next {
+	    incr i
+	    if { $i >= [llength $canvas_list] } {
+		set curcanvas [lindex $canvas_list 0]
+	    } else {
+		set curcanvas [lindex $canvas_list $i]
+	    }
+	}
+    }
+    redrawAll
+    return
 }
 
 
@@ -1964,11 +1991,17 @@ proc refreshCanvasMenu {} {
     global canvas_list curcanvas
 
     .menubar.canvas delete 0 end
+    .menubar.canvas add command -label "Previous" -accelerator "PgUp" \
+	-command { switchCanvas prev }
+    .menubar.canvas add command -label "Next" -accelerator "PgDown" \
+	-command { switchCanvas next }
+    .menubar.canvas add separator
     foreach canvas $canvas_list {
 	.menubar.canvas add radiobutton -label [getCanvasName $canvas] \
 		-command redrawAll -indicatoron true \
 		-value $canvas -variable curcanvas
     }
+    return
 }
 
 
@@ -1986,4 +2019,5 @@ proc animate {} {
     } else {
 	after 1500 animate
     }
+    return
 }
diff --git a/filemgmt.tcl b/filemgmt.tcl
index ec4ffb7..b277ef5 100755
--- a/filemgmt.tcl
+++ b/filemgmt.tcl
@@ -79,11 +79,13 @@ set fileTypes {{"IMUNES network configuration" {.imn} }
 
 proc newFile {} {
     global currentFile oper_mode
+    global canvas_list curcanvas
 
     if { $oper_mode == "exec" } {
 	vimageCleanup
     }
     loadCfg ""
+    set curcanvas [lindex $canvas_list 0]
     redrawAll
     set currentFile ""
     wm title . "IMUNES"
@@ -92,10 +94,8 @@ proc newFile {} {
 
 proc openFile {} {
     global currentFile 
-    global undolevel
-    global redolevel
-    global undolog
-    global activetool
+    global undolevel redolevel undolog activetool
+    global canvas_list curcanvas
     
     set fileName [file tail $currentFile]
     wm title . "IMUNES $fileName"
@@ -106,6 +106,7 @@ proc openFile {} {
     }
     close $fileId
     loadCfg $cfg
+    set curcanvas [lindex $canvas_list 0]
     redrawAll
     set undolevel 0
     set redolevel 0
diff --git a/initgui.tcl b/initgui.tcl
index a0fd16a..6d96cc0 100755
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -41,7 +41,7 @@
 set newlink ""
 set selectbox ""
 set selected ""
-newCanvas default
+newCanvas ""
 
 set animatephase 0
 set undolevel 0
@@ -153,17 +153,52 @@ bind . <Control-z> undo
     -accelerator "Ctrl+Y" -command redo
 bind . <Control-y> redo
 .menubar.edit add separator
+.menubar.edit add command -label "Select all" \
+    -accelerator "Ctrl+A" -command {
+	foreach obj [.c find withtag node] {
+	    selectNode .c $obj
+	}
+    }
+bind . <Control-a> {
+	foreach obj [.c find withtag node] {
+	    selectNode .c $obj
+	}
+    }
+.menubar.edit add separator
 .menubar.edit add command -label "New canvas" -underline 0 \
     -command {
 	newCanvas ""
+	set curcanvas [lindex $canvas_list 0]
+	switchCanvas prev
+	set changed 1
+	updateUndoLog
+	refreshCanvasMenu
+    }
+.menubar.edit add command -label "Delete canvas" -underline 0 \
+    -command {
+	if { [llength $canvas_list] == 1 } {
+	    return
+	}
+	foreach obj [.c find withtag node] {
+	    selectNode .c $obj
+	}
+	deleteSelection
+	set i [lsearch $canvas_list $curcanvas]
+	switchCanvas next
+	set canvas_list [lreplace $canvas_list $i $i]
+	set changed 1
+	updateUndoLog
 	refreshCanvasMenu
     }
 
 
+
 #
 # Canvas
 #
 menu .menubar.canvas -tearoff 0
+bind . <Prior> { switchCanvas prev }
+bind . <Next> { switchCanvas next }
 
 
 #
@@ -301,7 +336,6 @@ pack .bottom.oper_mode .bottom.mbuf .bottom.cpu_load .bottom.textbox \
 #
 # Event bindings and procedures for main canvas:
 #
-
 $c bind node <Any-Enter> "nodeEnter $c"
 $c bind link <Any-Enter> "linkEnter $c"
 $c bind linklabel <Any-Enter> "linkEnter $c"
@@ -319,7 +353,7 @@ bind $c <1> "button1 $c %x %y none"
 bind $c <Control-Button-1> "button1 $c %x %y ctrl"
 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"
+bind . <Delete> deleteSelection
 bind .menubar <Destroy> {setOperMode edit}
 
 # Scrolling and panning support