From 06e9a0ded7d4dbe8a9fff2afb88455500f824b38 Mon Sep 17 00:00:00 2001 From: miljenko Date: Fri, 20 Jul 2007 12:57:15 +0000 Subject: [PATCH] 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: --- annotations.tcl | 45 ++++++++++++++++++++++++++++---------------- cfgparse.tcl | 50 +++++++++++++++++++------------------------------ editor.tcl | 24 ++++++------------------ imunes.tcl | 7 ++----- 4 files changed, 56 insertions(+), 70 deletions(-) diff --git a/annotations.tcl b/annotations.tcl index b0631b3..dbe3a97 100644 --- 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 0c891c1..402d797 100755 --- 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 f3a141c..9c7a032 100755 --- 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 edc80eb..113eee3 100755 --- 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 -- 2.39.5