Synchronization with changes in HEAD/MAIN branch:

Keep all annotation objects in a single list (annotation_list),
instead of having three separate lists for text, rectangle and
oval objects.

In configuration file, deprecate text, rectangle, and oval object
classes, and replace them with a single annotation class.  The
type of annotation objects can be determined via proc nodeType.

Add an "xxx xxx xxx" asert in textConfigApply in a suspicious branch.

Remove the request for "raising" canvas objects tagged as "menuBubble"
in proc raiseAll, since it seems to be never used.

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

diff --git a/annotations.tcl b/annotations.tcl
index b0631b363098397f969b24fa1c363574fbbca8a9..dbe3a97d5fa8af0cc91a04ace187d5383a397ab3 100644 (file)
--- a/annotations.tcl
+++ b/annotations.tcl
@@ -160,7 +160,7 @@ proc destroyNewoval { c } {
 
 # create a oval
 proc popupOvalApply { c wi target} {
-    global newoval oval_list
+    global newoval annotation_list
     global $target
     global changed
 
@@ -173,8 +173,8 @@ proc popupOvalApply { c wi target} {
 
     # build the oval object
     if {$target == 0} {
-       set object [newObjectId "oval"]
-       lappend oval_list $object
+       set object [newObjectId annotation]
+       lappend annotation_list $object
        set coords [$c coords "$newoval"]
     } else {
        set object $target
@@ -235,13 +235,12 @@ proc button3annotation { type c x y } {
 
 
 proc deleteAnnotation { c type target } {
-    upvar ${type}_list type_list
-    global changed
+    global changed annotation_list
     
     $c delete -withtags "$type && $target"
     $c delete -withtags "new$type"
-    set i [lsearch -exact $type_list $target]
-    set type_list [lreplace $type_list $i $i]
+    set i [lsearch -exact annotation_list $target]
+    set annotation_list [lreplace annotation_list $i $i]
     set changed 1
     updateUndoLog
 }
@@ -467,7 +466,7 @@ proc destroyNewRect { c } {
 
 # create a rectangle
 proc popupRectApply { c wi target } {
-    global newrect rectangle_list
+    global newrect annotation_list
     global $target
     global changed
 
@@ -479,13 +478,12 @@ proc popupRectApply { c wi target } {
     set iconcoords "iconcoords"
 
     # build the oval object
-    # Prije: set object [newObjectId "rectangle"]
     set object $target
     if { $target == 0 } {
        # Create a new rectangle object
-       set target [newObjectId "rectangle"]
+       set target [newObjectId annotation]
        global $target
-       lappend rectangle_list $target
+       lappend annotation_list $target
        set coords [$c coords $newrect]
     } else {
        set coords [getNodeCoords $target]
@@ -621,10 +619,10 @@ proc selectmarkLeave {c x y} {
 
 
 proc textEnter { c x y } {
-    global text_list
+    global annotation_list
     global curcanvas
 
-    set object [newObjectId "text"]
+    set object [newObjectId annotation]
     set newtext [$c create text $x $y -text "" \
        -anchor w -justify left -tags "text $object"]
 
@@ -639,7 +637,7 @@ proc textEnter { c x y } {
     lappend $object "label {}"
     setNodeCanvas $object $curcanvas
 
-    lappend text_list $object
+    lappend annotation_list $object
     textConfig $c $object 
 }
 
@@ -827,7 +825,7 @@ proc fontupdate { label type args} {
 
 
 proc textConfigApply { c wi target } {
-    global text_list
+    global annotation_list
     global $target
     global fontfamily fontsize textBold textItalic textUnderline
     global changed
@@ -840,9 +838,11 @@ proc textConfigApply { c wi target } {
 
     # build the oval object
     if { $target == 0 } {
+       # XXX what is the purpose of this? --> leftover from copy/paste
+       xxx xxx xxx
        set target [newObjectId "target"]
        global $target
-       lappend text_list $target
+       lappend annotation_list $target
        set coords [$c coords $newtext]
     } else {
        set coords [getNodeCoords $target]
@@ -883,3 +883,16 @@ proc Call_Trace {{file stdout}} {
     }
 }
 
+proc drawAnnotation { obj } {
+    switch -exact -- [nodeType $obj] {
+       oval {
+           drawOval $obj
+       }
+       rectangle {
+           drawRect $obj
+       }
+       text {
+           drawText $obj
+       }
+    }
+}

diff --git a/cfgparse.tcl b/cfgparse.tcl
index 0c891c13fad2fd0af5016831aa49dde212562b28..402d7979c0fc8ef9a8648fca301034120f4695cf 100755 (executable)
--- a/cfgparse.tcl
+++ b/cfgparse.tcl
@@ -1,4 +1,4 @@
-# $Id: cfgparse.tcl,v 1.15.2.4 2007/07/19 03:31:21 marko Exp $ 
+# $Id: cfgparse.tcl,v 1.15.2.5 2007/07/20 12:57:15 miljenko Exp $ 
 #
 # Copyright 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -89,12 +89,11 @@ proc dumpputs {method dest string} {
 #****
 
 proc dumpCfg {method dest} {
-    global node_list link_list canvas_list
+    global node_list link_list canvas_list annotation_list
     global showIfNames showNodeLabels showLinkLabels
     global showIfIPaddrs showIfIPv6addrs
     global showIPsecConfig
     global showBkgImage showGrid showAnnotations
-    global oval_list rectangle_list text_list
 
     foreach node $node_list {
        global $node
@@ -140,7 +139,7 @@ proc dumpCfg {method dest} {
        dumpputs $method $dest ""
     }
 
-    foreach obj "rectangle oval text link canvas" {
+    foreach obj "link annotation canvas" {
        upvar 0 ${obj}_list obj_list
        foreach elem $obj_list {
            global $elem
@@ -208,20 +207,17 @@ proc dumpCfg {method dest} {
 #****
 
 proc loadCfg { cfg } {
-    global node_list link_list canvas_list
+    global node_list link_list canvas_list annotation_list
     global showIfNames showNodeLabels showLinkLabels
     global showIfIPaddrs showIfIPv6addrs
     global showIPsecConfig
     global showBkgImage showGrid showAnnotations
-    global oval_list rectangle_list text_list
 
     # Cleanup first
     set node_list {}
     set link_list {}
+    set annotation_list {}
     set canvas_list {}
-    set oval_list {}
-    set rectangle_list {}
-    set text_list {}
     set class ""
     set object ""
     foreach entry $cfg {
@@ -234,25 +230,17 @@ proc loadCfg { cfg } {
            set $object {}
            if {"$class" == "node"} {
                lappend node_list $object
-           }
-           if {"$class" == "link"} {
+           } elseif {"$class" == "link"} {
                lappend link_list $object
-           }
-           if {"$class" == "canvas"} {
+           } elseif {"$class" == "canvas"} {
                lappend canvas_list $object
-           }
-           if {"$class" == "option"} {
-               # for future use
-               lappend prefs $object
-           }
-           if {"$class" == "rectangle"} {
-               lappend rectangle_list $object
-           }
-           if {"$class" == "oval"} {
-               lappend oval_list $object
-           }
-           if {"$class" == "text"} {
-               lappend text_list $object
+           } elseif {"$class" == "option"} {
+               # do nothing
+           } elseif {"$class" == "annotation"} {
+               lappend annotation_list $object
+           } else {
+               puts "configuration parsing error: unknown object class $class"
+               exit 1
            }
            continue
        } else {
@@ -446,10 +434,11 @@ proc loadCfg { cfg } {
                            }
                        }
                    }
-               } elseif {"$class" == "oval" \
-                              || "$class" == "rectangle" \
-                              || "$class" == "text"} {
+               } elseif {"$class" == "annotation"} {
                    switch -exact -- $field {
+                       type {
+                           lappend $object "type $value"
+                       }
                        iconcoords {
                            lappend $object "iconcoords {$value}"
                        }
@@ -518,8 +507,7 @@ proc loadCfg { cfg } {
 #****
 
 proc newObjectId { type } {
-    global node_list link_list canvas_list
-    global oval_list rectangle_list text_list
+    global node_list link_list annotation_list canvas_list
 
     set mark [string range [set type] 0 0]
     set id 0

diff --git a/editor.tcl b/editor.tcl
index f3a141c9440f81e65e2a4b98d5439a7343fff4e5..9c7a0325776b1dfe28bfa6c1414d69b1cbaef8de 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -1,4 +1,4 @@
-# $Id: editor.tcl,v 1.62.2.7 2007/07/19 08:00:47 marko Exp $ 
+# $Id: editor.tcl,v 1.62.2.8 2007/07/20 12:57:15 miljenko Exp $ 
 #
 # Copyright 2004, 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -223,10 +223,9 @@ proc redo {} {
 #****
 
 proc redrawAll {} {
-    global node_list link_list background sizex sizey grid
+    global node_list link_list annotation_list background sizex sizey grid
     global curcanvas zoom
     global showBkgImage showAnnotations showGrid bkgImage
-    global oval_list label_list rectangle_list text_list
     .bottom.zoom config -text "zoom [expr {int($zoom * 100)}]%"
     set e_sizex [expr {int($sizex * $zoom)}]
     set e_sizey [expr {int($sizey * $zoom)}]
@@ -253,19 +252,9 @@ proc redrawAll {} {
     }
 
     if { $showAnnotations == 1 } {
-       foreach rect $rectangle_list {
-           if { [getNodeCanvas $rect] == $curcanvas } {
-               drawRect $rect
-           }
-       } 
-       foreach oval $oval_list {
-           if { [getNodeCanvas $oval] == $curcanvas } {
-               drawOval $oval
-           }
-       } 
-       foreach text $text_list {
-           if { [getNodeCanvas $text] == $curcanvas } {
-               drawText $text
+       foreach obj $annotation_list {
+           if { [getNodeCanvas $obj] == $curcanvas } {
+               drawAnnotation $obj
            }
        } 
     }
@@ -1836,8 +1825,7 @@ proc raiseAll { c } {
     $c raise interface "linklabel || link || grid || oval || rectangle || background"
     $c raise node "interface || linklabel || link || grid || oval || rectangle || background"
     $c raise nodelabel "node || interface || linklabel || link || grid || oval || rectangle || background"
-    $c raise menuBubble "nodelabel || node || interface || linklabel || link || grid || oval || rectangle || background"
-    $c raise text "menuBubble || nodelabel || node || interface || linklabel || link || grid || oval || rectangle || background"
+    $c raise text "nodelabel || node || interface || linklabel || link || grid || oval || rectangle || background"
 }
 
 #****f* editor.tcl/nodeEnter

diff --git a/imunes.tcl b/imunes.tcl
index edc80eb49f5bf8e3e0653771ede255c4f779d2dc..113eee3ef267a9d963c11bf5883fbc78285e5714 100755 (executable)
--- a/imunes.tcl
+++ b/imunes.tcl
@@ -1,4 +1,4 @@
-# $Id: imunes.tcl,v 1.19.2.4 2007/07/19 03:31:22 marko Exp $ 
+# $Id: imunes.tcl,v 1.19.2.5 2007/07/20 12:57:15 miljenko Exp $ 
 #
 # Copyright 2004, 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -158,11 +158,8 @@ source "$ROOTDIR/$LIBDIR/ns2imunes.tcl"
 
 set node_list {}
 set link_list {}
+set annotation_list {}
 set canvas_list {}
-set oval_list {}
-set rectangle_list {}
-set text_list {}
-set prefs {}
 set eid e0
 
 #****v* imunes.tcl/exec_hosts