From 9c95e235e222a81cee85c40ae3e23da46ac9ce18 Mon Sep 17 00:00:00 2001
From: marko <marko>
Date: Thu, 19 Jul 2007 08:08:58 +0000
Subject: [PATCH] Merge changes from RELENG_4_11.

Bug found by:
Submitted by:
Reviewed by:
Approved by:
Obtained from:
---
 annotations.tcl | 115 +++++-----
 canvas.tcl      |  80 ++++++-
 cfgparse.tcl    | 126 +++++++++--
 editor.tcl      | 548 ++++++++++++++++++++++++++++++++++++++++++------
 filemgmt.tcl    |  64 +++++-
 5 files changed, 793 insertions(+), 140 deletions(-)

diff --git a/annotations.tcl b/annotations.tcl
index 9aab519..b0631b3 100644
--- a/annotations.tcl
+++ b/annotations.tcl
@@ -106,13 +106,13 @@ proc popupOvalDialog { c target modify color label lcolor } {
 	set lcolor black
     }
     label $wi.colors.color -text $color -width 8 \
-	    -bg $color -fg $lcolor
+	-bg $color -fg $lcolor
     button $wi.colors.fg -text "fg" -command \
-	    "popupColor fg $wi.colors.color false"
+	"popupColor fg $wi.colors.color false"
     button $wi.colors.bg -text "bg" -command \
-	    "popupColor bg $wi.colors.color true"
+	"popupColor bg $wi.colors.color true"
     pack $wi.colors.fg $wi.colors.bg $wi.colors.color $wi.colors.label \
-	    -side right -padx 4 -pady 4
+	-side right -padx 4 -pady 4
     pack $wi.colors -side top
 
     set applycmd "popupOvalApply $c $wi $target"
@@ -182,10 +182,8 @@ proc popupOvalApply { c wi target} {
     global $object
     set $object {}
     lappend $iconcoords $coords
-    lappend $object $iconcoords
-    lappend $object "color $color"
-    lappend $object "label {$caption}"
-    lappend $object "labelcolor $labelcolor"
+    lappend $object $iconcoords "color $color" \
+	"label {$caption}" "labelcolor $labelcolor"
 
     # draw it
     drawOval $object
@@ -269,11 +267,12 @@ proc drawOval {oval} {
     if { $lcolor == "" } {
 	set lcolor black
     }
+    # -outline red -stipple gray50
     set newoval [.c create oval $x1 $y1 $x2 $y2 \
-	    -fill $color -width 2 -tags "oval $oval"]
+	-fill $color -width 2 -tags "oval $oval"]
     .c raise $newoval background
     .c create text $lx $ly -tags "oval $oval" -text $label \
-	    -justify center -font $defOvalLabelFont -fill $lcolor
+	-justify center -font $defOvalLabelFont -fill $lcolor
     setNodeCanvas $oval $curcanvas
     setType $oval "oval"
 }
@@ -291,12 +290,12 @@ proc popupColor { type l settext } {
 
     # set fg or bg of the "l" label control
     if { $newcolor == "" } {
-       return
+	return
     }
     if { $settext == "true" } {
-       $l configure -text $newcolor -$type $newcolor
+	$l configure -text $newcolor -$type $newcolor
     } else {
-       $l configure -$type $newcolor
+	$l configure -$type $newcolor
     }
 }
 
@@ -377,10 +376,10 @@ proc drawRect {rectangle} {
     # rounded-rectangle radius
     set rad 25
     set newrect [roundRect .c $x1 $y1 $x2 $y2 $rad \
-	    -fill $color -outline blue -tags "rectangle $rectangle"]
+	-fill $color -outline blue -tags "rectangle $rectangle"]
     .c raise $newrect background
     .c create text $lx $ly -tags "rectangle $rectangle" -text $label \
-	    -justify center -font $defRectLabelFont -fill $lcolor
+	-justify center -font $defRectLabelFont -fill $lcolor
     setNodeCanvas $rectangle $curcanvas
     setType $rectangle "rectangle"
 }
@@ -410,7 +409,7 @@ proc popupRectDialog { c rectangle modify color label lcolor } {
     frame $wi.lab -borderwidth 4
     label $wi.lab.name_label -text "Text for top of rectangle:"
     entry $wi.lab.name -bg white -width 16 \
-		-validate focus -invcmd "focusAndFlash %W"
+	-validate focus -invcmd "focusAndFlash %W"
     $wi.lab.name insert 0 $label
     pack $wi.lab.name $wi.lab.name_label -side right -padx 4 -pady 4
     pack $wi.lab -side top
@@ -425,13 +424,13 @@ proc popupRectDialog { c rectangle modify color label lcolor } {
 	set lcolor black
     }
     label $wi.colors.color -text $color -width 8 \
-	    -bg $color -fg $lcolor
+	-bg $color -fg $lcolor
     button $wi.colors.fg -text "fg" -command \
-	    "popupColor fg $wi.colors.color false"
+	"popupColor fg $wi.colors.color false"
     button $wi.colors.bg -text "bg" -command \
-	    "popupColor bg $wi.colors.color true"
+	"popupColor bg $wi.colors.color true"
     pack $wi.colors.fg $wi.colors.bg $wi.colors.color $wi.colors.label \
-	    -side right -padx 4 -pady 4
+	-side right -padx 4 -pady 4
     pack $wi.colors -side top
 
     # Add new oval or modify old one?
@@ -444,7 +443,8 @@ proc popupRectDialog { c rectangle modify color label lcolor } {
     }
     
     frame $wi.butt -borderwidth 6
-    button $wi.butt.apply -text $applytext -command "popupRectApply $c $wi $rectangle"
+    button $wi.butt.apply -text $applytext \
+	-command "popupRectApply $c $wi $rectangle"
 
     button $wi.butt.cancel -text "Cancel" -command $cancelcmd
     bind $wi <Key-Escape> "$cancelcmd" 
@@ -492,10 +492,8 @@ proc popupRectApply { c wi target } {
     }
     set $target {}
     lappend $iconcoords $coords
-    lappend $target $iconcoords
-    lappend $target "color $color"
-    lappend $target "label {$caption}"
-    lappend $target "labelcolor $labelcolor"
+    lappend $target $iconcoords "color $color" \
+	"label {$caption}" "labelcolor $labelcolor"
     
     # draw it
     drawRect $target
@@ -627,7 +625,8 @@ proc textEnter { c x y } {
     global curcanvas
 
     set object [newObjectId "text"]
-    set newtext [$c create text $x $y -text "" -anchor w -justify left -tags "text $object"]
+    set newtext [$c create text $x $y -text "" \
+	-anchor w -justify left -tags "text $object"]
 
     set coords [$c coords "text && $object"]
     set iconcoords "iconcoords"
@@ -673,8 +672,7 @@ proc drawText {text} {
     set font [list "$fontfamily" $fontsize]
     set effects [lindex [lsearch -inline [set $text] "effects *"] 1]
     set newtext [.c create text $x $y -text $label -anchor w \
-		    -font "$font $effects" -justify left -fill $color \
-		    -tags "text $text"]
+	-font "$font $effects" -justify left -fill $color -tags "text $text"]
 
     .c addtag text withtag $newtext
     .c raise $text background
@@ -729,9 +727,8 @@ proc textConfig { c target } {
     set fontmenu [tk_optionMenu $wi.prop.font.menu fontfamily "$fontfamily"]
     set sizemenu [tk_optionMenu $wi.prop.font.size fontsize "$fontsize"]
 
-    pack $wi.prop.font.label \
-	 $wi.prop.font.menu \
-	 $wi.prop.font.size -side left -pady 2
+    pack $wi.prop.font.label $wi.prop.font.menu \
+	$wi.prop.font.size -side left -pady 2
 
     frame $wi.prop.format -relief groove -bd 2
     label $wi.prop.format.label -text "Effects:"
@@ -742,20 +739,30 @@ proc textConfig { c target } {
 	set color $defTextColor
     }
     button $wi.prop.format.fg -text "Color" -command \
-		"popupColor fg $wi.text false"
+	"popupColor fg $wi.text false"
     checkbutton $wi.prop.format.bold -text "Bold" -variable textBold \
-	 -command [list fontupdate $wi.text bold]
+	-command [list fontupdate $wi.text bold]
     checkbutton $wi.prop.format.italic -text "Italic" -variable textItalic \
-	 -command [list fontupdate $wi.text italic]
-    checkbutton $wi.prop.format.underline -text "Underline" -variable textUnderline \
-	 -command [list fontupdate $wi.text underline]
+	-command [list fontupdate $wi.text italic]
+    checkbutton $wi.prop.format.underline -text "Underline" \
+	-variable textUnderline \
+	-command [list fontupdate $wi.text underline]
 
-    if {$textBold == 1} {      $wi.prop.format.bold select
-    } else {		   $wi.prop.format.bold deselect }
-    if {$textItalic == 1} {    $wi.prop.format.italic select
-    } else {		   $wi.prop.format.italic deselect }
-    if {$textUnderline == 1} { $wi.prop.format.underline select
-    } else {		   $wi.prop.format.underline deselect }
+    if {$textBold == 1} {
+	$wi.prop.format.bold select
+    } else {
+	$wi.prop.format.bold deselect
+    }
+    if {$textItalic == 1} {
+	$wi.prop.format.italic select
+    } else {
+	$wi.prop.format.italic deselect
+    }
+    if {$textUnderline == 1} {
+	$wi.prop.format.underline select
+    } else {
+	$wi.prop.format.underline deselect
+    }
 
     pack $wi.prop.format.label \
 	 $wi.prop.format.fg \
@@ -792,6 +799,7 @@ proc textConfig { c target } {
     pack $wi.action.apply $wi.action.cancel -side left ;# -fill x
 
     after 100 {
+	focus .popup.text
 	grab .popup
     }
     return
@@ -842,16 +850,21 @@ proc textConfigApply { c wi target } {
 	
     set $target {}
     lappend $iconcoords $coords
-    lappend $target $iconcoords
-    lappend $target "color $color"
-    lappend $target "label {$caption}"
-    lappend $target "fontfamily {$fontfamily}"
-    lappend $target "fontsize $fontsize"
+    lappend $target $iconcoords "color $color" "label {$caption}"\
+	"fontfamily {$fontfamily}" "fontsize $fontsize"
     set ef {}
-    if {"$textBold" == 1}   { lappend ef bold} 
-    if {"$textItalic" == 1} { lappend ef italic} 
-    if {"$textUnderline" == 1}   { lappend ef underline} 
-    if {"$ef" != ""} { lappend $target "effects {$ef}"}
+    if {"$textBold" == 1} {
+	lappend ef bold
+    } 
+    if {"$textItalic" == 1} {
+	lappend ef italic
+    } 
+    if {"$textUnderline" == 1} {
+	lappend ef underline
+    } 
+    if {"$ef" != ""} {
+	lappend $target "effects {$ef}"
+    }
 
     # draw it
     drawText $target
diff --git a/canvas.tcl b/canvas.tcl
index b72f5e9..046e50e 100755
--- a/canvas.tcl
+++ b/canvas.tcl
@@ -1,4 +1,4 @@
-# $Id: canvas.tcl,v 1.10 2007/05/07 08:43:19 ana Exp $ 
+# $Id: canvas.tcl,v 1.11 2007/07/19 08:08:58 marko Exp $ 
 #
 # Copyright 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -42,7 +42,7 @@
 #
 #****
 
-#****f* nodecfg.tcl/removeCanvas
+#****f* canvas.tcl/removeCanvas
 # NAME
 #   removeCanvas -- remove canvas 
 # SYNOPSIS
@@ -63,7 +63,7 @@ proc removeCanvas { canvas } {
     set $canvas {}
 }
 
-#****f* nodecfg.tcl/newCanvas
+#****f* canvas.tcl/newCanvas
 # NAME
 #   newCanvas -- craete new canvas 
 # SYNOPSIS
@@ -118,7 +118,7 @@ proc getCanvasSize { canvas } {
     }
 }
 
-#****f* nodecfg.tcl/getCanvasName
+#****f* canvas.tcl/getCanvasName
 # NAME
 #   getCanvasName -- get canvas name
 # SYNOPSIS
@@ -138,7 +138,7 @@ proc getCanvasName { canvas } {
     return [string trim $entry \{\}]
 }
 
-#****f* nodecfg.tcl/setCanvasName
+#****f* canvas.tcl/setCanvasName
 # NAME
 #   setCanvasName -- set canvas name
 # SYNOPSIS
@@ -160,3 +160,73 @@ proc setCanvasName { canvas name } {
 	set $canvas [linsert [set $canvas] 1 "name {$name}"]
     }
 }
+
+#****f* canvas.tcl/getCanvasBkg
+# NAME
+#   getCanvasBkg -- get canvas background image file name
+# SYNOPSIS
+#   set canvasBkgImage [getCanvasBkg $canvas_id]
+# FUNCTION
+#   Returns the name of the canvas background image file.
+# INPUTS
+#   * canvas_id -- canvas id
+# RESULT
+#   * canvasBkgImage -- image file name
+#****
+
+proc getCanvasBkg { canvas } {
+    global $canvas
+
+    set entry [lrange [lsearch -inline [set $canvas] "bkgImage *"] 1 end]
+    return [string trim $entry \{\}]
+}
+
+#****f* canvas.tcl/setCanvasBkg
+# NAME
+#   setCanvasBkg -- set canvas background
+# SYNOPSIS
+#   setCanvasBkg $canvas_id $bkgImage
+# FUNCTION
+#   Sets the background image for the canvas.
+# INPUTS
+#   * canvas_id -- canvas id
+#   * bkgImage -- image file name
+#****
+
+proc setCanvasBkg { canvas name } {
+    global $canvas
+
+    set i [lsearch [set $canvas] "bkgImage *"]
+    if { $i >= 0 } {
+	set $canvas [lreplace [set $canvas] $i $i "bkgImage {$name}"]
+    } else {
+	set $canvas [linsert [set $canvas] 1 "bkgImage {$name}"]
+    }
+}
+
+
+set bkgImage ""
+
+#****f* canvas.tcl/selectBkgImage
+# NAME
+#   selectBkgImage -- select and set canvas background image
+# SYNOPSIS
+#   selectBkgImage
+# FUNCTION
+#   Select image file (gif) and use it as canvas background image
+#****
+
+proc selectBkgImage {} {
+    global bkgImage imageFileTypes showBkgImage curcanvas
+    set imageFileTypes {{"GIF images" {.gif}}
+			{"All files"  {*}   }}
+
+    set selectedFile [tk_getOpenFile -filetypes $imageFileTypes]
+    if { $selectedFile != ""} {
+	set bkgImage $selectedFile
+	set showBkgImage 1
+	setCanvasBkg $curcanvas $bkgImage
+	redrawAll
+    }
+}
+
diff --git a/cfgparse.tcl b/cfgparse.tcl
index 4471480..88b0cd3 100755
--- a/cfgparse.tcl
+++ b/cfgparse.tcl
@@ -1,4 +1,4 @@
-# $Id: cfgparse.tcl,v 1.33 2007/07/19 03:17:12 marko Exp $ 
+# $Id: cfgparse.tcl,v 1.34 2007/07/19 08:08:58 marko Exp $ 
 #
 # Copyright 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -53,7 +53,7 @@
 #   Puts a sting to the file or appends the string configuration (used for 
 #   undo functions), the choice depends on the value of method parameter.
 # INPUTS
-#   * method -- used method. Possiable values are file (if saving the string 
+#   * method -- method used. Possiable values are file (if saving the string 
 #   to the file) and string (if appending the string configuration)
 #   * dest -- destination used. File_id for files, and string name for string 
 #   configuration
@@ -93,6 +93,8 @@ proc dumpCfg {method dest} {
     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
@@ -138,26 +140,18 @@ proc dumpCfg {method dest} {
 	dumpputs $method $dest ""
     }
 
-    foreach link $link_list {
-	global $link
-	upvar 0 $link llink
-	dumpputs $method $dest "link $link \{"
-	foreach element $llink {
-	    dumpputs $method $dest "    $element"
+    foreach obj "rectangle oval text link canvas" {
+	upvar 0 ${obj}_list obj_list
+	foreach elem $obj_list {
+	    global $elem
+	    upvar 0 $elem lelem
+	    dumpputs $method $dest "$obj $elem \{"
+	    foreach element $lelem {
+		dumpputs $method $dest "    $element"
+	    }
+	    dumpputs $method $dest "\}"
+	    dumpputs $method $dest ""
 	}
-	dumpputs $method $dest "\}"
-	dumpputs $method $dest ""
-    }
-
-    foreach canvas $canvas_list {
-	global $canvas
-	upvar 0 $canvas lcanvas
-	dumpputs $method $dest "canvas $canvas \{"
-	foreach element $lcanvas {
-	    dumpputs $method $dest "    $element"
-	}
-	dumpputs $method $dest "\}"
-	dumpputs $method $dest ""
     }
 
     dumpputs $method $dest "option show \{"
@@ -185,6 +179,18 @@ proc dumpCfg {method dest} {
 	dumpputs $method $dest "    ipsec_configs no"
     } else {
 	dumpputs $method $dest "    ipsec_configs yes" }
+    if {$showBkgImage == 0} {
+	dumpputs $method $dest "    background_images no"
+    } else {
+	dumpputs $method $dest "    background_images yes" }
+    if {$showAnnotations == 0} {
+	dumpputs $method $dest "    annotations no"
+    } else {
+	dumpputs $method $dest "    annotations yes" }
+    if {$showGrid == 0} {
+	dumpputs $method $dest "    grid no"
+    } else {
+	dumpputs $method $dest "    grid yes" }
     dumpputs $method $dest "\}"
     dumpputs $method $dest ""
 }
@@ -206,12 +212,16 @@ proc loadCfg { cfg } {
     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 canvas_list {}
-
+    set oval_list {}
+    set rectangle_list {}
+    set text_list {}
     set class ""
     set object ""
     foreach entry $cfg {
@@ -235,6 +245,15 @@ proc loadCfg { cfg } {
 		# 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
+	    }
 	    continue
 	} else {
 	    set line [concat $entry]
@@ -310,7 +329,7 @@ proc loadCfg { cfg } {
 				lappend cfg $zline
 			    }
 			    set cfg [lrange $cfg 1 [expr {[llength $cfg] - 2}]]
-			    lappend $object "ipsec-config {$cfg}"
+				lappend $object "ipsec-config {$cfg}"
 			}
 			iconcoords {
 			    lappend $object "iconcoords {$value}"
@@ -357,6 +376,9 @@ proc loadCfg { cfg } {
 			size {
 			    lappend $object "size {$value}"
 			}
+			bkgImage {
+			    lappend $object "bkgImage {$value}"
+			}
 		    }
 		} elseif {"$class" == "option"} {
 		    switch -exact -- $field {
@@ -402,6 +424,62 @@ proc loadCfg { cfg } {
 				set showIPsecConfig 1
 			    }
 			}
+			background_images {
+			    if { $value == "no" } {
+				set showBkgImage 0
+			    } elseif { $value == "yes" } {
+				set showBkgImage 1
+			    }
+			}
+			annotations {
+			    if { $value == "no" } {
+				set showAnnotations 0
+			    } elseif { $value == "yes" } {
+				set showAnnotations 1
+			    }
+			}
+			grid {
+			    if { $value == "no" } {
+				set showGrid 0
+			    } elseif { $value == "yes" } {
+				set showGrid 1
+			    }
+			}
+		    }
+		} elseif {"$class" == "oval" \
+			       || "$class" == "rectangle" \
+			       || "$class" == "text"} {
+		    switch -exact -- $field {
+			iconcoords {
+			    lappend $object "iconcoords {$value}"
+			}
+			color {
+			    lappend $object "color $value"
+			}
+			label {
+			    lappend $object "label {$value}"
+			}
+			labelcolor {
+			    lappend $object "labelcolor $value"
+			}
+			size {
+			    lappend $object "size $value"
+			}
+			canvas {
+			    lappend $object "canvas $value"
+			}
+			font {
+			    lappend $object "font {$value}"
+			}
+			fontfamily {
+			    lappend $object "fontfamily {$value}"
+			}
+			fontsize {
+			    lappend $object "fontsize {$value}"
+			}
+			effects {
+			    lappend $object "effects {$value}"
+			}
 		    }
 		}
 	    }
@@ -441,6 +519,7 @@ proc loadCfg { cfg } {
 
 proc newObjectId { type } {
     global node_list link_list canvas_list
+    global oval_list rectangle_list text_list
 
     set mark [string range [set type] 0 0]
     set id 0
@@ -449,3 +528,4 @@ proc newObjectId { type } {
     }
     return $mark$id
 }
+
diff --git a/editor.tcl b/editor.tcl
index fac8bce..01d10f6 100755
--- a/editor.tcl
+++ b/editor.tcl
@@ -1,4 +1,4 @@
-# $Id: editor.tcl,v 1.69 2007/07/19 04:44:34 marko Exp $ 
+# $Id: editor.tcl,v 1.70 2007/07/19 08:08:58 marko Exp $ 
 #
 # Copyright 2004, 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -225,7 +225,8 @@ proc redo {} {
 proc redrawAll {} {
     global node_list link_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)}]
@@ -235,33 +236,64 @@ proc redrawAll {} {
 	[expr {$e_sizey + $border}]"
 
     .c delete all
-    set background [.c create rectangle 0 0 $e_sizex $e_sizey \
-	-fill white -tags "background"]
+
+    set canvasBkgImage [getCanvasBkg $curcanvas]
+    if { $showBkgImage == 1 && "$canvasBkgImage" != ""} {
+	set ret [backgroundImage .c $canvasBkgImage]
+	if { "$ret" == 2 } {
+	    set background [.c create rectangle 0 0 $e_sizex $e_sizey \
+		    -fill white -tags "background"]
+	} else {
+	    set background [.c create rectangle 0 0 $e_sizex $e_sizey \
+		    -tags "background"]
+	}
+    } else {
+	set background [.c create rectangle 0 0 $e_sizex $e_sizey \
+	    -fill white -tags "background"]
+    }
+
+    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
+	    }
+	} 
+    }
 
     # Grid
     set e_grid [expr {int($grid * $zoom)}]
     set e_grid2 [expr {$e_grid * 2}]
-    if { 1 } {
+    if { $showGrid } {
 	for { set x $e_grid } { $x < $e_sizex } { incr x $e_grid } {
 	    if { [expr {$x % $e_grid2}] != 0 } {
 		if { $zoom > 0.5 } {
 		    .c create line $x 1 $x $e_sizey \
-			-fill gray -dash {1 7} -tags "background"
+			-fill gray -dash {1 7} -tags "grid"
 		}
 	    } else {
 		.c create line $x 1 $x $e_sizey -fill gray -dash {1 3} \
-		    -tags "background"
+		   -tags "grid"
 	    }
 	}
 	for { set y $e_grid } { $y < $e_sizey } { incr y $e_grid } {
 	    if { [expr {$y % $e_grid2}] != 0 } {
 		if { $zoom > 0.5 } {
 		    .c create line 1 $y $e_sizex $y \
-			-fill gray -dash {1 7} -tags "background"
+			-fill gray -dash {1 7} -tags "grid"
 		}
 	    } else {
 		.c create line 1 $y $e_sizex $y -fill gray -dash {1 3} \
-		    -tags "background"
+		    -tags "grid"
 	    }
 	}
     }
@@ -285,6 +317,7 @@ proc redrawAll {} {
     }
 
     .c config -cursor left_ptr
+    raiseAll .c
 }
 
 #****f* editor.tcl/drawNode
@@ -750,9 +783,19 @@ proc splitGUILink { link } {
 #****
 proc selectNode { c obj } {
     set node [lindex [$c gettags $obj] 1]
+
     $c addtag selected withtag "node && $node"
     if { [nodeType $node] == "pseudo" } {
 	set bbox [$c bbox "nodelabel && $node"]
+    } elseif { [nodeType $node] == "rectangle" } {
+	$c addtag selected withtag "rectangle && $node"
+	set bbox [$c bbox "rectangle && $node"]
+    } elseif { [nodeType $node] == "text" } {
+	$c addtag selected withtag "text && $node"
+	set bbox [$c bbox "text && $node"]
+    } elseif { [nodeType $node] == "oval" } {
+	$c addtag selected withtag "oval && $node"
+	set bbox [$c bbox "oval && $node"]
     } else {
 	set bbox [$c bbox "node && $node"]
     }
@@ -776,6 +819,15 @@ proc selectedNodes {} {
     foreach obj [.c find withtag "node && selected"] {
 	lappend selected [lindex [.c gettags $obj] 1]
     }
+    foreach obj [.c find withtag "oval && selected"] {
+	lappend selected [lindex [.c gettags $obj] 1]
+    }
+    foreach obj [.c find withtag "rectangle && selected"] {
+	lappend selected [lindex [.c gettags $obj] 1]
+    }
+    foreach obj [.c find withtag "text && selected"] {
+	lappend selected [lindex [.c gettags $obj] 1]
+    }
     return $selected
 }
 
@@ -1259,9 +1311,11 @@ proc button1 { c x y button } {
     global node_list curcanvas zoom
     global activetool newlink curobj changed def_router_model
     global router pc host lanswitch frswitch rj45 hub
+    global oval rectangle text
     global lastX lastY
     global background selectbox
     global defLinkColor defLinkWidth
+    global resizemode resizeobj
 
     set x [$c canvasx $x]
     set y [$c canvasy $y]
@@ -1271,7 +1325,9 @@ proc button1 { c x y button } {
 
     set curobj [$c find withtag current]
     set curtype [lindex [$c gettags current] 0]
-    if { $curtype == "node" || ( $curtype == "nodelabel" &&
+    if { $curtype == "node" || 
+	 $curtype == "oval" || $curtype == "rectangle" || $curtype == "text"
+	 || ( $curtype == "nodelabel" &&
 	[nodeType [lindex [$c gettags $curobj] 1]] == "pseudo") } {
 	set node [lindex [$c gettags current] 1]
 	set wasselected \
@@ -1289,12 +1345,61 @@ proc button1 { c x y button } {
 	if { $activetool == "select" && !$wasselected} {
 	    selectNode $c $curobj
 	}
+    } elseif { $curtype == "selectmark" } {
+
+	set t1 [$c gettags current]
+	set o1 [lindex $t1 1]
+	set type1 [nodeType $o1]
+    
+	if {$type1== "oval" || $type1== "rectangle"} { 
+	    set resizeobj $o1
+	    set bbox1 [$c bbox $o1]
+	    set x1 [lindex $bbox1 0]
+	    set y1 [lindex $bbox1 1]
+	    set x2 [lindex $bbox1 2]
+	    set y2 [lindex $bbox1 3]
+	    set l 0 ;# left
+	    set r 0 ;# right
+	    set u 0 ;# up
+	    set d 0 ;# down
+
+	    if { $x < [expr $x1+($x2-$x1)/8.0]} { set l 1 }
+	    if { $x > [expr $x2-($x2-$x1)/8.0]} { set r 1 }
+	    if { $y < [expr $y1+($y2-$y1)/8.0]} { set u 1 }
+	    if { $y > [expr $y2-($y2-$y1)/8.0]} { set d 1 }
+       
+	    if {$l==1} {
+		if {$u==1} { 
+		    set resizemode lu
+		} elseif {$d==1} { 
+		    set resizemode ld
+		} else { 
+		    set resizemode l
+		} 
+	    } elseif {$r==1} {
+		if {$u==1} { 
+		    set resizemode ru
+		} elseif {$d==1} { 
+		    set resizemode rd
+		} else { 
+		    set resizemode r
+		} 
+	    } elseif {$u==1} { 
+		set resizemode u
+	    } elseif {$d==1} {
+		set resizemode d
+	    } else {
+		set resizemode false
+	    }
+	}
+
     } elseif { $button != "ctrl" || $activetool != "select" } {
 	$c dtag node selected
 	$c delete -withtags selectmark
     }
-    if { [lsearch [.c gettags $curobj] background] != -1 } {
-	if { [lsearch {select link} $activetool] < 0 } {
+    if { [lsearch [.c gettags $curobj] background] != -1  ||
+	 [lsearch [.c gettags $curobj] grid] != -1 } {
+	if { [lsearch {select link oval rectangle text} $activetool] < 0 } {
 	    set node [newNode $activetool]
 	    setNodeCanvas $node $curcanvas
 	    setNodeCoords $node "[expr {$x / $zoom}] [expr {$y / $zoom}]"
@@ -1317,6 +1422,14 @@ proc button1 { c x y button } {
 		$c delete $selectbox
 		set selectbox ""
 	    }
+	} elseif { $activetool == "oval" || $activetool == "rectangle" } {
+	    $c config -cursor cross
+	    set lastX $x
+	    set lastY $y
+	} elseif { $activetool == "text" } {
+	    $c config -cursor xterm
+	    set lastX $x
+	    set lastY $y
 	}
     } else {
 	if {$curtype == "node" || $curtype == "nodelabel"} {
@@ -1331,11 +1444,8 @@ proc button1 { c x y button } {
 		-tags "link"]
 	}
     }
-    $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"
+
+    raiseAll $c
 }
 
 
@@ -1357,7 +1467,7 @@ proc button1 { c x y button } {
 proc button1-motion { c x y } {
     global activetool newlink changed
     global lastX lastY sizex sizey selectbox background
-
+    global oper_mode newoval newrect resizemode
     set x [$c canvasx $x]
     set y [$c canvasy $y]
 
@@ -1366,7 +1476,7 @@ proc button1-motion { c x y } {
     if {$activetool == "link" && $newlink != ""} {
 	$c coords $newlink $lastX $lastY $x $y
     } elseif { $activetool == "select" && \
-	( $curobj == $selectbox || $curtype == "background" )} {
+	( $curobj == $selectbox || $curtype == "background" || $curtype == "grid")} {
 	if {$selectbox == ""} {
 	    set selectbox [$c create line \
 		$lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY \
@@ -1376,22 +1486,106 @@ proc button1-motion { c x y } {
 	    $c coords $selectbox \
 		$lastX $lastY $x $lastY $x $y $lastX $y $lastX $lastY
 	}
+    } elseif { $activetool == "select" && $curtype == "text" } {
+	$c move $curobj [expr {$x - $lastX}] [expr {$y - $lastY}]
+	set changed 1
+	set lastX $x
+	set lastY $y
+	$c delete [$c find withtag "selectmark"]
     } elseif { $activetool == "select" && $curtype == "nodelabel" \
-    && [nodeType [lindex [$c gettags $curobj] 1]] != "pseudo" } {
+	&& [nodeType [lindex [$c gettags $curobj] 1]] != "pseudo" } {
 	$c move $curobj [expr {$x - $lastX}] [expr {$y - $lastY}]
 	set changed 1
 	set lastX $x
 	set lastY $y
+			# actually we should check if curobj==bkgImage
+    } elseif { $activetool == "oval" && \
+      ( $curobj == $newoval || $curobj == $background || $curtype == "background" || $curtype == "grid")} {
+      # Draw a new oval
+	if {$newoval == ""} {
+	    set newoval [$c create oval $lastX $lastY $x $y \
+			-dash {10 4} -width 1 -tags "newoval"]
+	    $c raise $newoval "background || link || linklabel || interface"
+	} else {
+	    $c coords $newoval \
+		$lastX $lastY $x $y
+	}
+			# actually we should check if curobj==bkgImage
+    } elseif { $activetool == "rectangle" && \
+      ( $curobj == $newrect || $curobj == $background || $curtype == "background") || $curtype == "grid"} {
+      # Draw a new rectangle
+	if {$newrect == ""} {
+	    set newrect [$c create rectangle $lastX $lastY $x $y \
+			-outline blue \
+			-dash {10 4} -width 1 -tags "newrect"]
+	    $c raise $newrect "oval || background || link || linklabel || interface"
+	} else {
+	    $c coords $newrect $lastX $lastY $x $y
+	}
+    } elseif { $curtype == "selectmark" } {
+	foreach o [$c find withtag "selected"] { 
+	    set node [lindex [$c gettags $o] 1]
+	    set tagovi [$c gettags $o]
+	    set koord [getNodeCoords $node]
+
+	    set oldX1 [lindex $koord 0]
+	    set oldY1 [lindex $koord 1]
+	    set oldX2 [lindex $koord 2]
+	    set oldY2 [lindex $koord 3]
+	    switch -exact -- $resizemode {
+		lu {
+		    set oldX1 $x
+		    set oldY1 $y
+		}
+		ld {
+		    set oldX1 $x
+		    set oldY2 $y
+		}
+		l {
+		    set oldX1 $x
+		}
+		ru {
+		    set oldX2 $x
+		    set oldY1 $y
+		}
+		rd {
+		    set oldX2 $x
+		    set oldY2 $y
+		}
+		r {
+		    set oldX2 $x
+		}
+		u {
+		    set oldY1 $y
+		}
+		d {
+		    set oldY2 $y
+		}
+	    }
+	    if {$selectbox == ""} {
+		set selectbox [$c create line \
+		    $oldX1 $oldY1 $oldX2 $oldY1 $oldX2 $oldY2 $oldX1 $oldY2 $oldX1 $oldY1 \
+		    -dash {10 4} -fill black -width 1 -tags "selectbox"]
+		$c raise $selectbox "background || link || linklabel || interface"
+	    } else {
+		$c coords $selectbox \
+		    $oldX1 $oldY1 $oldX2 $oldY1 $oldX2 $oldY2 $oldX1 $oldY2 $oldX1 $oldY1
+	    }
+	}
     } else {
 	foreach img [$c find withtag "selected"] {
 	    set node [lindex [$c gettags $img] 1]
 	    set img [$c find withtag "selectmark && $node"]
-	    $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}]
-	    set img [$c find withtag "node && $node"]
-	    $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}]
-	    set img [$c find withtag "nodelabel && $node"]
-	    $c move $img [expr {$x - $lastX}] [expr {$y - $lastY}]
-	    $c addtag need_redraw withtag "link && $node"
+	    if {$curtype == "oval" || $curtype == "rectangle"} {
+		$c move $img [expr {($x - $lastX) / 2}] [expr {($y - $lastY) / 2}]
+	    } else {
+		$c move $img [expr {$x - $lastX}] [expr {$y - $lastY}]
+		set img [$c find withtag "node && $node"]
+		$c move $img [expr {$x - $lastX}] [expr {$y - $lastY}]
+		set img [$c find withtag "nodelabel && $node"]
+		$c move $img [expr {$x - $lastX}] [expr {$y - $lastY}]
+		$c addtag need_redraw withtag "link && $node"
+	    }
 	}
 	foreach link [$c find withtag "link && need_redraw"] {
 	    redrawLink [lindex [$c gettags $link] 1]
@@ -1482,6 +1676,8 @@ proc button1-release { c x y } {
     global changed undolog undolevel redolevel selectbox
     global lastX lastY sizex sizey zoom
     global autorearrange_enabled
+    global resizemode resizeobj
+    set redrawNeeded 0
 
     set x [$c canvasx $x]
     set y [$c canvasy $y]
@@ -1510,6 +1706,12 @@ proc button1-release { c x y } {
 		}
 	    }
 	}
+    } elseif {$activetool == "rectangle" } {
+	popupRectDialog $c 0 "false" "" "" ""
+    } elseif {$activetool == "oval" } {
+	popupOvalDialog $c 0 "false" "" "" ""
+    } elseif {$activetool == "text" } {
+	textEnter $c $x $y
     }
 
     if { $changed == 1 } {
@@ -1540,17 +1742,26 @@ proc button1-release { c x y } {
 	    if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} {
 		set regular false
 	    }
-	    $c move "nodelabel && $node" $dx $dy
-	    set coords [$c coords "nodelabel && $node"]
-	    set x [expr {[lindex $coords 0] / $zoom}]
-	    set y [expr {[lindex $coords 1] / $zoom}]
-	    setNodeLabelCoords $node "$x $y"
-	    if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} {
-		set regular false
+	    if { [lindex [$c gettags $node] 0] == "oval" ||
+		 [lindex [$c gettags $node] 0] == "rectangle" } {
+		set bbox [$c bbox "selectmark && $node"]
+		setNodeCoords $node "$bbox"
+		set redrawNeeded 1
+	    }
+	    if {[$c find withtag "nodelabel && $node"] != "" } {
+		$c move "nodelabel && $node" $dx $dy
+		set coords [$c coords "nodelabel && $node"]
+		set x [expr {[lindex $coords 0] / $zoom}]
+		set y [expr {[lindex $coords 1] / $zoom}]
+		setNodeLabelCoords $node "$x $y"
+		if {$x < 0 || $y < 0 || $x > $sizex || $y > $sizey} {
+		    set regular false
+		}
 	    }
 	    $c move "selectmark && $node" $dx $dy
 	    $c addtag need_redraw withtag "link && $node"
-	}
+	    set changed 1
+	} ;# end of: foreach img selected
 	if {$regular == "true"} {
 	    foreach link [$c find withtag "link && need_redraw"] {
 		redrawLink [lindex [$c gettags $link] 1]
@@ -1565,7 +1776,9 @@ proc button1-release { c x y } {
 	    set changed 0
 	}
 	$c dtag link need_redraw
-    } elseif {$activetool == "select" } {
+
+    # $changed!=1
+    } elseif {$activetool == "select" } { 
 	if {$selectbox == ""} {
 	    set x1 $x
 	    set y1 $y
@@ -1579,26 +1792,56 @@ proc button1-release { c x y } {
 	    $c delete $selectbox
 	    set selectbox ""
 	}
-	set enclosed {}
-	foreach obj [$c find enclosed $x $y $x1 $y1] {
-	    set tags [$c gettags $obj]
-	    if {[lindex $tags 0] == "node" && [lsearch $tags selected] == -1} {
-		lappend enclosed $obj
+
+	if { $resizemode == "false" } {
+	    set enclosed {}
+	    foreach obj [$c find enclosed $x $y $x1 $y1] {
+		set tags [$c gettags $obj]
+		if {[lindex $tags 0] == "node" && [lsearch $tags selected] == -1} {
+		    lappend enclosed $obj
+		}
+		if {[lindex $tags 0] == "oval" && [lsearch $tags selected] == -1} {
+		    lappend enclosed $obj
+		}
+		if {[lindex $tags 0] == "rectangle" && [lsearch $tags selected] == -1} {
+		    lappend enclosed $obj
+		}
+		if {[lindex $tags 0] == "text" && [lsearch $tags selected] == -1} {
+		    lappend enclosed $obj
+		}
 	    }
-	}
-	foreach obj $enclosed {
-	    selectNode $c $obj
+	    foreach obj $enclosed {
+		selectNode $c $obj
+	    }
+	} else {
+	    setNodeCoords $resizeobj "$x $y $x1 $y1"
+	    set redrawNeeded 1
+	    set resizemode false
 	}
     }
-    $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"
+
+    if { $redrawNeeded } {
+	set redrawNeeded 0
+	redrawAll
+    } else {
+	raiseAll $c
+    }
     update
     updateUndoLog
 }
 
+proc raiseAll { c } {
+    $c raise rectangle background
+    $c raise oval "rectangle || background"
+    $c raise grid "oval || rectangle || background"
+    $c raise link "grid || oval || rectangle || background"
+    $c raise linklabel "link || grid || oval || rectangle || background"
+    $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"
+}
 
 #****f* editor.tcl/nodeEnter
 # NAME
@@ -1783,6 +2026,15 @@ proc popupConfigDialog { c } {
     if { [lsearch {link linklabel} $tk_type] > -1 } {
 	set object_type link
     }
+    if { [lsearch {oval} $tk_type] > -1 } {
+	set object_type oval
+    }
+    if { [lsearch {rectangle} $tk_type] > -1 } {
+	set object_type rectangle
+    }
+    if { [lsearch {text} $tk_type] > -1 } {
+	set object_type text
+    }
     if { "$object_type" == ""} {
 	destroy $wi
 	return
@@ -2064,6 +2316,21 @@ proc popupConfigDialog { c } {
 	    pack $wi.cpu -side top -anchor w -fill both
 	}
     }
+    oval {
+	destroy $wi
+	annotationConfig $c $target
+	return
+    }
+    rectangle {
+	destroy $wi
+	annotationConfig $c $target
+	return
+    }
+    text {
+	destroy $wi
+	textConfig $c $target
+	return
+    }
     link {
 	wm title $wi "link configuration"
 	frame $wi.ftop -borderwidth 6
@@ -2149,6 +2416,8 @@ proc popupConfigDialog { c } {
     "set badentry -1 ; destroy $wi"
     pack $wi.butt.cancel $wi.butt.apply -side right
     pack $wi.butt -side bottom
+    bind $wi <Key-Escape> "set badentry -1; destroy $wi"
+    bind $wi <Key-Return> "popupConfigApply $wi $object_type $target 0"
     after 100 {
 	grab .popup
     }
@@ -2636,11 +2905,7 @@ proc deleteSelection { } {
 	}
 	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"
+    raiseAll .c
     updateUndoLog
     .c config -cursor left_ptr
     .bottom.textbox config -text ""
@@ -2947,11 +3212,21 @@ proc renameCanvasPopup {} {
     set w .entry1
     catch {destroy $w}
     toplevel $w -takefocus 1
-    update
-    grab $w
+
+    if { $x == 0 && $y == 0 } {
+	set screen [wm maxsize .]
+	set x [expr {[lindex $screen 0] / 2}]
+	set y [expr {[lindex $screen 1] / 2}]
+    } else {
+	set x [expr {$x + 10}]
+	set y [expr {$y - 90}]
+    }
+    wm geometry $w +$x+$y
     wm title $w "Canvas rename"
     wm iconname $w "Canvas rename"
 
+    update
+    grab $w
     label $w.msg -wraplength 5i -justify left -text "Canvas name:"
     pack $w.msg -side top
 
@@ -2961,6 +3236,9 @@ proc renameCanvasPopup {} {
     button $w.buttons.cancel -text "Cancel" -command "destroy $w"
     pack $w.buttons.print $w.buttons.cancel -side left -expand 1
 
+    bind $w <Key-Escape> "destroy $w"
+    bind $w <Key-Return> "renameCanvasApply $w"
+
     entry $w.e1 -bg white
     $w.e1 insert 0 [getCanvasName $curcanvas]
     pack $w.e1 -side top -pady 5 -padx 10 -fill x
@@ -2985,6 +3263,8 @@ proc resizeCanvasPopup {} {
     button $w.buttons.print -text "Apply" -command "resizeCanvasApply $w"
     button $w.buttons.cancel -text "Cancel" -command "destroy $w"
     pack $w.buttons.print $w.buttons.cancel -side left -expand 1
+    bind $w <Key-Escape> "destroy $w"
+    bind $w <Key-Return> "resizeCanvasApply $w"
 
     frame $w.size
     pack $w.size -side top -fill x -pady 2m
@@ -3071,15 +3351,45 @@ proc zoom { dir } {
     global zoom
 
     set stops ".25 .5 .75 1.0 1.5 2.0 4.0"
-    set i [lsearch $stops $zoom]
+    # set i [lsearch $stops $zoom]
+    set minzoom [lindex $stops 0]
+    set maxzoom [lindex $stops [expr [llength $stops] - 1]]
     switch -exact -- $dir {
 	"down" {
-	    if { $i >0 } {
-		set zoom [lindex $stops [expr $i - 1]]
-		redrawAll
+	    if {$zoom > $maxzoom} {
+		set zoom $maxzoom
+	    } elseif {$zoom < $minzoom} {
+		; # leave it unchanged
+	    } else {
+		set newzoom $minzoom
+		foreach z $stops {
+		    if {$zoom <= $z} {
+			break
+		    } else {
+			set newzoom $z
+		    }
+		}
+		set zoom $newzoom 
 	    }
+	    redrawAll
 	}
 	"up" {
+	    if {$zoom < $minzoom} {
+		set zoom $minzoom
+	    } elseif {$zoom > $maxzoom} {
+		; # leave it unchanged
+	    } else {
+		foreach z [lrange $stops 1 end] {
+		    set newzoom $z
+		    if {$zoom < $z} {
+			break
+		    }
+		}
+		set zoom $newzoom 
+	    }
+	    redrawAll
+	}
+	default {
 	    if { $i < [expr [llength $stops] - 1] } {
 		set zoom [lindex $stops [expr $i + 1]]
 		redrawAll
@@ -3089,3 +3399,123 @@ proc zoom { dir } {
 }
 
 
+#****h* editor.tcl/double1onGrid
+# NAME
+#  double1onGrid.tcl -- called on Double-1 click on grid (bind command)
+# SYNOPSIS
+#  double1onGrid $c %x %y
+# FUNCTION
+#  As grid is layered above annotations this procedure is used to find 
+#  annotation object closest to cursor
+#****
+
+proc double1onGrid { c x y } {
+    set obj [$c find closest $x $y]
+    set tags [$c gettags $obj]
+    set node [lindex $tags 1]
+    if {[lsearch $tags grid] != -1 || [lsearch $tags background] != -1} {
+	return
+    }
+    # Is this really necessary?
+    set coords [getNodeCoords $node] 
+    set x1 [lindex $coords 0]
+    set y1 [lindex $coords 1]
+    set x2 [lindex $coords 2]
+    set y2 [lindex $coords 3]
+    if {$x < $x1 || $x > $x2 || $y < $y1 || $y > $y2} {
+	# cursor is not ON the closest object
+	return
+    } else {
+	annotationConfig $c $node
+    }
+}
+
+proc setZoom { x y } {
+    global curcanvas
+    global zoom
+
+    set w .entry1
+    catch {destroy $w}
+    toplevel $w -takefocus 1
+
+    if { $x == 0 && $y == 0 } {
+	set screen [wm maxsize .]
+	set x [expr {[lindex $screen 0] / 2}]
+	set y [expr {[lindex $screen 1] / 2}]
+    } else {
+	set x [expr {$x + 10}]
+	set y [expr {$y - 90}]
+    }
+    wm geometry $w +$x+$y
+    wm title $w "Set zoom %"
+    wm iconname $w "Set zoom %"
+
+    update
+    grab $w
+    label $w.msg -wraplength 5i -justify left -text "Zoom percentage:"
+    pack $w.msg -side top
+
+    frame $w.buttons
+    pack $w.buttons -side bottom -fill x -pady 2m
+    button $w.buttons.print -text "Apply" -command "setZoomApply $w"
+    button $w.buttons.cancel -text "Cancel" -command "destroy $w"
+    pack $w.buttons.print $w.buttons.cancel -side left -expand 1
+
+    bind $w <Key-Escape> "destroy $w"
+    bind $w <Key-Return> "setZoomApply $w"
+
+    entry $w.e1 -bg white
+    $w.e1 insert 0 [expr {int($zoom * 100)}]
+    pack $w.e1 -side top -pady 5 -padx 10 -fill x
+}
+
+proc setZoomApply { w } {
+    global zoom changed
+
+    set newzoom [expr [$w.e1 get] / 100.0]
+    if { $newzoom != $zoom } {
+	set zoom $newzoom
+	redrawAll
+    }
+    destroy $w
+}
+
+proc selectZoom { x y } {
+    global curcanvas
+    global zoom
+
+    set stops ".25 .5 .75 1.0 1.5 2.0 4.0"
+
+    set w .entry1
+    catch {destroy $w}
+    toplevel $w -takefocus 1
+
+    if { $x == 0 && $y == 0 } {
+	set screen [wm maxsize .]
+	set x [expr {[lindex $screen 0] / 2}]
+	set y [expr {[lindex $screen 1] / 2}]
+    } else {
+	set x [expr {$x + 10}]
+	set y [expr {$y - 90}]
+    }
+    wm geometry $w +$x+$y
+    wm title $w "Select zoom %"
+    wm iconname $w "Select zoom %"
+
+    update
+    grab $w
+
+    frame $w.buttons
+    pack $w.buttons -side bottom -fill x -pady 2m
+    button $w.buttons.print -text "Apply" -command "setZoomApply $w"
+    button $w.buttons.cancel -text "Cancel" -command "destroy $w"
+    pack $w.buttons.print $w.buttons.cancel -side left -expand 1
+
+    bind $w <Key-Escape> "destroy $w"
+    bind $w <Key-Return> "setZoomApply $w"
+
+    entry $w.e1 -bg white
+    $w.e1 insert 0 [expr {int($zoom * 100)}]
+    pack $w.e1 -side top -pady 5 -padx 10 -fill x
+}
+
diff --git a/filemgmt.tcl b/filemgmt.tcl
index 55cbe77..3400f3a 100755
--- a/filemgmt.tcl
+++ b/filemgmt.tcl
@@ -1,4 +1,4 @@
-# $Id: filemgmt.tcl,v 1.11 2007/07/19 03:14:13 marko Exp $ 
+# $Id: filemgmt.tcl,v 1.12 2007/07/19 08:08:58 marko Exp $ 
 #
 # Copyright 2004, 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -137,7 +137,7 @@ proc openFile {} {
     loadCfg $cfg
     set curcanvas [lindex $canvas_list 0]
     switchCanvas none
-    redrawAll
+    # already called from switchCanvas: redrawAll
     set undolevel 0
     set redolevel 0
     set undolog(0) $cfg 
@@ -309,3 +309,63 @@ proc readConfigFile {} {
     }
 }
 
+# Currently not used
+#proc checkBkgImageFilenames {} {
+#    global canvas_list
+#    foreach canvas $canvas_list {
+#	global $canvas
+#	puts [set $canvas]
+#	set i [lsearch [set $canvas] "bkgImage *"]
+#	if { $i >= 0 } {
+#	    set oldname [getCanvasBkg $canvas]
+#	    set newname [relpath $oldname]
+#	    puts "Staro ime: $oldname novo ime: $newname" 
+#	    set $canvas [lreplace [set $canvas] $i $i "bkgImage {$newname}"]
+#	}
+#    }
+#}
+
+
+#****f* filemgmt.tcl/relpath
+# NAME
+#   relpath -- return background image filename relative to configuration file
+# SYNOPSIS
+#   relpath bkgImageFilename
+# FUNCTION
+#   Returns relative pathname
+#
+#***
+#####
+# Some examples
+# puts [relpath /root/imunes/labos.imn /root/EXAMPLES/labos.gif]
+# ../EXAMPLES/labos.gif
+# puts [relpath /root/EXAMPLES/labos.imn /root/EXAMPLES/labos.gif]
+# ./labos.gif
+
+;#proc relpath {basedir target} {
+proc relpath {target} {
+    global currentFile
+    set basedir $currentFile
+    # Try and make a relative path to a target file/dir from base directory
+    set bparts [file split [file normalize $basedir]]
+    set tparts [file split [file normalize $target]]
+
+    if {[lindex $bparts 0] eq [lindex $tparts 0]} {
+	# If the first part doesn't match - there is no good relative path
+	set blen [expr {[llength $bparts] - 1}]
+	set tlen [llength $tparts]
+	for {set i 1} {$i < $blen && $i < $tlen} {incr i} {
+	    if {[lindex $bparts $i] ne [lindex $tparts $i]} { break }
+	}
+	set path [lrange $tparts $i end]
+	for {} {$i < $blen} {incr i} {
+	    set path [linsert $path 0 ..]
+	}
+	# Full name:
+	# [file normalize [join $path [file separator]]]
+	# Relative file name:
+	return [join $path [file separator]]
+    }
+    return $target
+}
+
-- 
2.39.5