From: marko <marko>
Date: Fri, 20 Jul 2007 22:52:32 +0000 (+0000)
Subject: Merge back changes from RELENG_4_11:
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=edcde471c87affc23d193ac0a3d74d2b5347a903;p=imunes.git

Merge back changes from RELENG_4_11:

Rectangle, circle (oval) AND TEXT annotations are configured using
a single proc.

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

diff --git a/annotations.tcl b/annotations.tcl
index 4ce719b..0be38ad 100644
--- a/annotations.tcl
+++ b/annotations.tcl
@@ -20,22 +20,15 @@
 #****
 
 proc annotationConfig { c target } {
-    global newoval $target
-
-    set color [lindex [lsearch -inline [set $target] "color *"] 1]
-    set label [lindex [lsearch -inline [set $target] "label *"] 1]
-    set lcolor [lindex [lsearch -inline [set $target] "labelcolor *"] 1]
-    
-    # set newoval $target
     switch -exact -- [nodeType $target] {
 	oval {
-	    popupOvalDialog $c $target "true" $color $label $lcolor
+	    popupAnnotationDialog $c $target "true"
 	}
 	rectangle {
-	    popupRectDialog $c $target "true" $color $label $lcolor
+	    popupAnnotationDialog $c $target "true"
 	}
 	text {
-	    textConfig $c $target 
+	    popupAnnotationDialog $c $target "true"
 	}
 	default {
 	    puts "Unknown type [nodeType $target] for target $target"
@@ -67,76 +60,10 @@ proc annotationConfig { c target } {
 #   * lcolor -- label (text) color
 #****
 
-proc popupOvalDialog { c target modify color label lcolor } {
-    global newoval defOvalColor $target
-
-
-    # do nothing, return, if coords are empty
-    if { $target == 0 && [$c coords "$newoval"] == "" } {
-	return
-    }
-    set wi .popup
-    catch {destroy $wi}
-    toplevel $wi
-
-    wm transient $wi .
-    wm resizable $wi 0 0
-
-    if { $modify == "true" } {
-	set windowtitle "Configure oval"
-    } else {
-	set windowtitle "Add a new oval"
-    }
-    wm title $wi $windowtitle
-    frame $wi.lab -borderwidth 4
-    label $wi.lab.name_label -text "Text for top of oval:"
-    entry $wi.lab.name -bg white -width 16 \
-	-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
-
-    # color selection controls
-    frame $wi.colors -borderwidth 4
-    label $wi.colors.label -text "Color:"
-    if { $color == "" } {
-	set color $defOvalColor
-    }
-    if { $lcolor == "" } {
-	set lcolor black
-    }
-    label $wi.colors.color -text $color -width 8 \
-	-bg $color -fg $lcolor
-    button $wi.colors.fg -text "fg" -command \
-	"popupColor fg $wi.colors.color false"
-    button $wi.colors.bg -text "bg" -command \
-	"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
-    pack $wi.colors -side top
-
-    set applycmd "popupOvalApply $c $wi $target"
-
-    # Add new oval or modify old one?
-    if { $modify == "true"  } {
-	set cancelcmd "destroy $wi"
-	set applytext "Modify oval"
-    } else {
-	set cancelcmd "destroy $wi; destroyNewoval $c"
-	set applytext "Add oval"
-    }
 
-    frame $wi.butt -borderwidth 6
-    button $wi.butt.apply -text $applytext -command "$applycmd"
-    button $wi.butt.cancel -text "Cancel" -command $cancelcmd
-    bind $wi <Key-Escape> "$cancelcmd" 
-    bind $wi <Key-Return> "$applycmd"
-    pack $wi.butt.cancel $wi.butt.apply -side right
-    pack $wi.butt -side bottom
-    after 100 {
-	grab .popup
-    }
-    return
+proc adjustBkg { c wi } {
+    set color [$wi.colors.color cget -text]
+    $wi.border.color configure -bg $color
 }
 
 
@@ -158,44 +85,6 @@ proc destroyNewoval { c } {
 }
 
 
-# create a oval
-proc popupOvalApply { c wi target} {
-    global newoval annotation_list
-    global $target
-    global changed
-
-    # oval attributes
-    set caption [string trim [$wi.lab.name get]]
-    set color [$wi.colors.color cget -text]
-    set labelcolor [$wi.colors.color cget -fg]
-    set coords [$c coords "$target"]
-    set iconcoords "iconcoords"
-
-    # build the oval object
-    if {$target == 0} {
-	set object [newObjectId annotation]
-	lappend annotation_list $object
-	set coords [$c coords "$newoval"]
-    } else {
-	set object $target
-    }
-    global $object
-    set $object {}
-    lappend $iconcoords $coords
-    lappend $object $iconcoords "color $color" \
-	"label {$caption}" "labelcolor $labelcolor"
-
-    # draw it
-    drawOval $object
-
-    destroyNewoval $c
-    destroy $wi 
-    set changed 1
-    updateUndoLog
-    redrawAll
-}
-
-
 # oval/rectangle/text right-click menu
 
 proc button3annotation { type c x y } {
@@ -247,7 +136,8 @@ proc deleteAnnotation { c type target } {
 
 
 proc drawOval {oval} {
-    global $oval defOvalColor defOvalLabelFont zoom curcanvas
+    global $oval defFillColor zoom curcanvas
+    global defTextFontFamily defTextFontSize
 
     set coords [getNodeCoords $oval]
     set x1 [expr {[lindex $coords 0] * $zoom}]
@@ -257,21 +147,36 @@ proc drawOval {oval} {
     set color [lindex [lsearch -inline [set $oval] "color *"] 1]
     set label [lindex [lsearch -inline [set $oval] "label *"] 1]
     set lcolor [lindex [lsearch -inline [set $oval] "labelcolor *"] 1]
+    set bordercolor [lindex [lsearch -inline [set $oval] "border *"] 1]
+    set width [lindex [lsearch -inline [set $oval] "width *"] 1]
     set lx [expr $x1 + (($x2 - $x1) / 2)]
     set ly [expr ($y1 + 20)]
 
-    if { $color == "" } {
-	set color $defOvalColor
-    }
-    if { $lcolor == "" } {
-	set lcolor black
-    }
+    if { $color == "" } { set color $defFillColor }
+    if { $lcolor == "" } { set lcolor black }
+    if { $width == "" } { set width 1 }
+    if { $bordercolor == "" } { set bordercolor black }
+
     # -outline red -stipple gray50
     set newoval [.c create oval $x1 $y1 $x2 $y2 \
-	-fill $color -width 2 -tags "oval $oval"]
+	-fill $color -width $width -outline $bordercolor -tags "oval $oval"]
     .c raise $newoval background
+
+    set fontfamily [lindex [lsearch -inline [set $oval] "fontfamily *"] 1]
+    set fontsize [lindex [lsearch -inline [set $oval] "fontsize *"] 1]
+    if { $fontfamily == "" } {
+	set fontfamily $defTextFontFamily
+    }
+    if { $fontsize == "" } {
+	set fontsize $defTextFontSize
+    }
+    set newfontsize $fontsize
+    set font [list "$fontfamily" $fontsize]
+    set effects [lindex [lsearch -inline [set $oval] "effects *"] 1]
+
     .c create text $lx $ly -tags "oval $oval" -text $label \
-	-justify center -font $defOvalLabelFont -fill $lcolor
+	-justify center -font "$font $effects" -fill $lcolor
+
     setNodeCanvas $oval $curcanvas
     setType $oval "oval"
 }
@@ -313,7 +218,7 @@ proc popupColor { type l settext } {
 #   * x0, y0 -- Coordinates of the upper left corner, in pixels
 #   * x3, y3 -- Coordinates of the lower right corner, in pixels
 #   * radius -- Radius of the bend at the corners, in any form
-#	       acceptable to Tk_GetPixels
+#		acceptable to Tk_GetPixels
 #   * args   -- Other args suitable to a 'polygon' item on the canvas
 # Example:
 #   roundRect .c 100 50 500 250 $rad -fill white -outline black -tags rectangle
@@ -348,7 +253,8 @@ proc roundRect { w x0 y0 x3 y3 radius args } {
  }
 
 proc drawRect {rectangle} {
-    global $rectangle defRectColor defRectLabelFont zoom curcanvas
+    global $rectangle defFillColor zoom curcanvas
+    global defTextFontFamily defTextFontSize
 
     set coords [getNodeCoords $rectangle]
     if {$coords == ""} {
@@ -363,35 +269,114 @@ proc drawRect {rectangle} {
     set color [lindex [lsearch -inline [set $rectangle] "color *"] 1]
     set label [lindex [lsearch -inline [set $rectangle] "label *"] 1]
     set lcolor [lindex [lsearch -inline [set $rectangle] "labelcolor *"] 1]
+    set bordercolor [lindex [lsearch -inline [set $rectangle] "border *"] 1]
+    set width [lindex [lsearch -inline [set $rectangle] "width *"] 1]
+    set rad [lindex [lsearch -inline [set $rectangle] "rad *"] 1]
     set lx [expr $x1 + (($x2 - $x1) / 2)]
     set ly [expr ($y1 + 20)]
 
-    if { $color == "" } {
-	set color $defRectColor
-    }
-    if { $lcolor == "" } {
-	set lcolor black
-    }
+    if { $color == "" } { set color $defFillColor }
+    if { $lcolor == "" } { set lcolor black }
+    if { $bordercolor == "" } { set bordercolor black }
+    if { $width == "" } { set width 1 }
     # rounded-rectangle radius
-    set rad 25
+    if { $rad == "" } { set rad 25 }
+
     set newrect [roundRect .c $x1 $y1 $x2 $y2 $rad \
-	-fill $color -outline blue -tags "rectangle $rectangle"]
+	-fill $color -outline $bordercolor -width $width \
+	-tags "rectangle $rectangle"]
     .c raise $newrect background
+
+    set fontfamily [lindex [lsearch -inline [set $rectangle] "fontfamily *"] 1]
+    set fontsize [lindex [lsearch -inline [set $rectangle] "fontsize *"] 1]
+    if { $fontfamily == "" } {
+	set fontfamily $defTextFontFamily
+    }
+    if { $fontsize == "" } {
+	set fontsize $defTextFontSize
+    }
+    set newfontsize $fontsize
+    set font [list "$fontfamily" $fontsize]
+    set effects [lindex [lsearch -inline [set $rectangle] "effects *"] 1]
+
     .c create text $lx $ly -tags "rectangle $rectangle" -text $label \
-	-justify center -font $defRectLabelFont -fill $lcolor
+	-justify center -font "$font $effects" -fill $lcolor
+
     setNodeCanvas $rectangle $curcanvas
     setType $rectangle "rectangle"
 }
 
 
-proc popupRectDialog { c rectangle modify color label lcolor } {
-    global newrect defRectColor
-    global $rectangle
+proc popupAnnotationDialog { c target modify } {
+    global $target newrect newoval 
+    global width rad fontfamily fontsize
+    global defFillColor defTextColor defTextFontFamily defTextFontSize
 
     # do nothing, return, if coords are empty
-    if { $rectangle == 0 && [$c coords "$newrect"] == "" } {
+    if { $target == 0 \
+	    && [$c coords "$newrect"] == "" \
+	    && [$c coords "$newoval"] == "" } {
 	return
     }
+    if { $target == 0 } {
+	set width 1
+	set rad 25
+	set coords [$c bbox "$newrect"]
+	if { [$c coords "$newrect"] == "" } {
+	    set coords [$c bbox "$newoval"]
+	    set annotationType "oval"
+	} else {
+	    set annotationType "rectangle"
+	}
+	set fontfamily ""
+	set fontsize ""
+	set effects ""
+	set color ""
+	set label ""
+	set lcolor ""
+	set bordercolor ""
+    } else {
+	set width [lindex [lsearch -inline [set $target] "width *"] 1]
+	set rad [lindex [lsearch -inline [set $target] "rad *"] 1]
+	set coords [$c bbox "$target"]
+	set color [lindex [lsearch -inline [set $target] "color *"] 1]
+	set fontfamily [lindex [lsearch -inline [set $target] "fontfamily *"] 1]
+	set fontsize [lindex [lsearch -inline [set $target] "fontsize *"] 1]
+	set effects [lindex [lsearch -inline [set $target] "effects *"] 1]
+
+	set label [lindex [lsearch -inline [set $target] "label *"] 1]
+	set lcolor [lindex [lsearch -inline [set $target] "labelcolor *"] 1]
+	set bordercolor [lindex [lsearch -inline [set $target] "border *"] 1]
+	set annotationType [nodeType $target]
+    }
+
+    if { $color == "" } { set color $defFillColor }
+    if { $lcolor == "" } { set lcolor black }
+    if { $bordercolor == "" } { set bordercolor black }
+    if { $width == "" } { set width 1 }
+    if { $rad == "" } { set rad 25 }
+    if { $fontfamily == "" } { set fontfamily $defTextFontFamily }
+    if { $fontsize == "" } { set fontsize $defTextFontSize }
+
+    set textBold 0
+    set textItalic 0
+    set textUnderline 0
+    if { [lsearch $effects bold ] != -1} {set textBold 1}
+    if { [lsearch $effects italic ] != -1} {set textItalic 1}
+    if { [lsearch $effects underline ] != -1} {set textUnderline 1}
+
+    set x1 [lindex $coords 0] 
+    set y1 [lindex $coords 1]
+    set x2 [lindex $coords 2]
+    set y2 [lindex $coords 3]
+    set xx [expr {abs($x2 - $x1)}] 
+    set yy [expr {abs($y2 - $y1)}] 
+    if { $xx > $yy } {
+	set maxrad [expr $yy * 3.0 / 8.0]
+    } else {
+	set maxrad [expr $xx * 3.0 / 8.0]
+    }
+
     set wi .popup
     catch {destroy $wi}
     toplevel $wi
@@ -400,63 +385,149 @@ proc popupRectDialog { c rectangle modify color label lcolor } {
     wm resizable $wi 0 0
 
     if { $modify == "true" } {
-	set windowtitle "Configure rectangle $rectangle"
+	set windowtitle "Configure $annotationType $target"
     } else {
-	set windowtitle "Add a new rectangle"
+	set windowtitle "Add a new $annotationType"
     }
     wm title $wi $windowtitle
-    frame $wi.lab -borderwidth 4
-    label $wi.lab.name_label -text "Text for top of rectangle:"
-    entry $wi.lab.name -bg white -width 16 \
+
+    frame $wi.text -relief groove -bd 2
+    frame $wi.text.lab
+    label $wi.text.lab.name_label -text "Text for top of $annotationType:"
+    entry $wi.text.lab.name -bg white -fg $lcolor -width 32 \
 	-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
+    $wi.text.lab.name insert 0 $label
+    pack $wi.text.lab.name_label $wi.text.lab.name -side left -anchor w \
+	-padx 2 -pady 2 -fill x
+    pack $wi.text.lab -side top -fill x
 
-    # color selection controls
-    frame $wi.colors -borderwidth 4
-    label $wi.colors.label -text "Color:"
+    frame $wi.text.format 
+
+    set fontmenu [tk_optionMenu $wi.text.format.fontmenu fontfamily "$fontfamily"]
+    set sizemenu [tk_optionMenu $wi.text.format.fontsize fontsize "$fontsize"]
+
+
+    # color selection 
     if { $color == "" } {
-	set color $defRectColor
+	set color $defTextColor
     }
-    if { $lcolor == "" } {
-	set lcolor black
+    button $wi.text.format.fg -text "Text color" -command \
+	"popupColor fg $wi.text.lab.name false"
+    checkbutton $wi.text.format.bold -text "Bold" -variable textBold \
+	-command [list fontupdate $wi.text.lab.name bold]
+    checkbutton $wi.text.format.italic -text "Italic" -variable textItalic \
+	-command [list fontupdate $wi.text.lab.name italic]
+    checkbutton $wi.text.format.underline -text "Underline" \
+	-variable textUnderline \
+	-command [list fontupdate $wi.text.lab.name underline]
+
+    if {$textBold == 1} {	$wi.text.format.bold select
+    } else {			$wi.text.format.bold deselect }
+    if {$textItalic == 1} {	$wi.text.format.italic select
+    } else {			$wi.text.format.italic deselect }
+    if {$textUnderline == 1} {	$wi.text.format.underline select
+    } else {			$wi.text.format.underline deselect }
+
+    pack $wi.text.format.fontmenu \
+	$wi.text.format.fontsize \
+	$wi.text.format.fg \
+	$wi.text.format.bold \
+	$wi.text.format.italic \
+	$wi.text.format.underline \
+	-side left -pady 2
+
+    pack $wi.text.format -side top -fill x
+
+    pack $wi.text -side top -fill x
+
+    fontupdate $wi.text.lab.name fontfamily $fontfamily
+    fontupdate $wi.text.lab.name fontsize $fontsize
+
+    $fontmenu delete 0
+    foreach f [lsort -dictionary [font families]] {
+	$fontmenu add radiobutton -value "$f" -label $f \
+	    -variable fontfamily \
+	    -command [list fontupdate $wi.text.lab.name fontfamily $f]
+    }
+ 
+    $sizemenu delete 0
+    foreach f {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} {
+	$sizemenu add radiobutton -value "$f" -label $f \
+	    -variable fontsize \
+	    -command [list fontupdate $wi.text.lab.name fontsize $f]
     }
+ 
+if { "$annotationType" == "rectangle" || "$annotationType" == "oval" } {
+
+    # fill color, border color
+    frame $wi.colors -relief groove -bd 2
+    # color selection controls
+    label $wi.colors.label -text "Fill color:"
+
     label $wi.colors.color -text $color -width 8 \
 	-bg $color -fg $lcolor
-    button $wi.colors.fg -text "fg" -command \
-	"popupColor fg $wi.colors.color false"
-    button $wi.colors.bg -text "bg" -command \
+    button $wi.colors.bg -text "Color" -command \
 	"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
-    pack $wi.colors -side top
+    pack $wi.colors.label $wi.colors.color $wi.colors.bg \
+	-side left -padx 2 -pady 2 -anchor w -fill x
+    pack $wi.colors -side top -fill x
+
+    # border selection controls
+    frame $wi.border -relief groove -bd 2
+    label $wi.border.label -text "Border color:"
+    label $wi.border.color -text $bordercolor -width 8 \
+	-bg $color -fg $bordercolor
+    label $wi.border.width_label -text "Border width:"
+    set widthMenu [tk_optionMenu $wi.border.width width "$width"]
+    $widthMenu delete 0
+    foreach f {0 1 2 3 4 5 6 7 8 9 10} {
+	$widthMenu add radiobutton -value $f -label $f \
+	    -variable width
+    }
+    button $wi.border.fg -text "Color" -command \
+	"popupColor fg $wi.border.color true"
+    pack $wi.border.label $wi.border.color $wi.border.fg \
+	$wi.border.width_label $wi.border.width \
+	$wi.border.fg $wi.border.color $wi.border.label \
+	-side left -padx 2 -pady 2 -anchor w -fill x
+    pack $wi.border -side top -fill x
+
+}
+
+if { $annotationType == "rectangle" } {
+    frame $wi.radius -relief groove -bd 2
+    scale $wi.radius.rad -from 0 -to [expr int($maxrad)] \
+	-length 400 -variable rad \
+	-orient horizontal -label "Radius of the bend at the corners: " \
+	-tickinterval [expr int($maxrad / 15) + 1] -showvalue true
+    pack $wi.radius.rad -side left -padx 2 -pady 2 -anchor w -fill x
+    pack $wi.radius -side top -fill x
+}
 
     # Add new oval or modify old one?
     if { $modify == "true"  } {
 	set cancelcmd "destroy $wi"
-	set applytext "Modify rectangle"
+	set applytext "Modify $annotationType"
     } else {
 	set cancelcmd "destroy $wi; destroyNewRect $c"
-	set applytext "Add rectangle"
+	set applytext "Add $annotationType"
     }
     
     frame $wi.butt -borderwidth 6
-    button $wi.butt.apply -text $applytext \
-	-command "popupRectApply $c $wi $rectangle"
+    button $wi.butt.apply -text $applytext -command "popupAnnotationApply $c $wi $target $annotationType"
 
     button $wi.butt.cancel -text "Cancel" -command $cancelcmd
     bind $wi <Key-Escape> "$cancelcmd" 
-    bind $wi <Key-Return> "popupRectApply $c $wi $rectangle"
+    bind $wi <Key-Return> "popupAnnotationApply $c $wi $target $annotationType"
     pack $wi.butt.cancel $wi.butt.apply -side right
     pack $wi.butt -side bottom
+
     after 100 {
 	grab .popup
     }
     return
 }
 
-
 # helper for popupOvalDialog and popupOvalApply
 proc destroyNewRect { c } {
     global newrect
@@ -464,39 +535,65 @@ proc destroyNewRect { c } {
     set newrect ""
 }
 
-# create a rectangle
-proc popupRectApply { c wi target } {
-    global newrect annotation_list
+
+proc popupAnnotationApply { c wi target type } {
+    global newrect newoval annotation_list
     global $target
     global changed
+    global width rad
+    global fontfamily fontsize textBold textItalic textUnderline
 
     # attributes
-    set caption [string trim [$wi.lab.name get]]
-    set color [$wi.colors.color cget -text]
-    set labelcolor [$wi.colors.color cget -fg]
+    set caption [string trim [$wi.text.lab.name get]]
+    set labelcolor [$wi.text.lab.name cget -fg]
     set coords [$c coords "$target"]
     set iconcoords "iconcoords"
 
-    # build the oval object
-    # Prije: set object [newObjectId annotation]
-    set object $target
+    if {"$type" == "rectangle" || "$type" == "oval" } {
+	set color [$wi.colors.color cget -text]
+	set bordercolor [$wi.border.color cget -text]
+    }
+
     if { $target == 0 } {
-	# Create a new rectangle object
+	# Create a new annotation object
 	set target [newObjectId annotation]
 	global $target
 	lappend annotation_list $target
-	set coords [$c coords $newrect]
+	if {"$type" == "rectangle" } {
+	    set coords [$c coords $newrect]
+        } elseif { "$type" == "oval" } {
+	    set coords [$c coords $newoval]
+	}
     } else {
 	set coords [getNodeCoords $target]
     }
     set $target {}
     lappend $iconcoords $coords
-    lappend $target $iconcoords "color $color" \
-	"label {$caption}" "labelcolor $labelcolor"
-    
+    lappend $target $iconcoords "label {$caption}" "labelcolor $labelcolor" \
+	"fontfamily {$fontfamily}" "fontsize $fontsize"
+    if {"$type" == "rectangle" || "$type" == "oval" } {
+	lappend $target "color $color" "width $width" "border $bordercolor" 
+    }
+    if {"$type" == "rectangle" } {
+	lappend $target "rad $rad"
+    }
+
+    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}"}
+
     # draw it
-    drawRect $target
-    destroyNewRect $c
+    if { $type == "rectangle" } {
+        drawRect $target
+        destroyNewRect $c
+    } elseif { $type == "oval" } {
+        drawOval $target
+        destroyNewoval $c
+    } elseif { $type == "text" } {
+        drawText $target
+    }
 
     set changed 1
     updateUndoLog
@@ -639,7 +736,7 @@ proc textEnter { c x y } {
     setNodeCanvas $object $curcanvas
 
     lappend annotation_list $object
-    textConfig $c $object 
+    popupAnnotationDialog $c $object "false"
 }
 
 
@@ -654,7 +751,7 @@ proc drawText {text} {
     }
     set x [expr {[lindex $coords 0] * $zoom}]
     set y [expr {[lindex $coords 1] * $zoom}]
-    set color [lindex [lsearch -inline [set $text] "color *"] 1]
+    set color [lindex [lsearch -inline [set $text] "labelcolor *"] 1]
     if { $color == "" } {
 	set color $defTextColor
     }
@@ -680,130 +777,6 @@ proc drawText {text} {
 }
 
 
-proc textConfig { c target } {
-    global $target defTextColor defTextFont defTextFontFamily defTextFontSize
-    global fontfamily fontsize
-
-    set color [lindex [lsearch -inline [set $target] "color *"] 1]
-    set label [lindex [lsearch -inline [set $target] "label *"] 1]
-    set fontfamily [lindex [lsearch -inline [set $target] "fontfamily *"] 1]
-    set fontsize [lindex [lsearch -inline [set $target] "fontsize *"] 1]
-    set font [list "$fontfamily" $fontsize]
-
-    set textBold 0
-    set textItalic 0
-    set textUnderline 0
-    set effects [lindex [lsearch -inline [set $target] "effects *"] 1]
-    if { [lsearch $effects bold ] != -1} {set textBold 1}
-    if { [lsearch $effects italic ] != -1} {set textItalic 1}
-    if { [lsearch $effects underline ] != -1} {set textUnderline 1}
-
-    if { $fontfamily == "" } {
-	set fontfamily $defTextFontFamily
-    }
-    if { $fontsize == "" } {
-	set fontsize $defTextFontSize
-    }
-
-    set wi .popup
-    catch {destroy $wi}
-    toplevel $wi
-
-    wm transient $wi .
-    wm resizable $wi 1 1
-    wm title $wi "Configure text"
-
-    $wi configure -bd 2 -relief raised
-
-    entry $wi.text -background white
-    frame $wi.prop 
-    frame $wi.action
-    pack $wi.text $wi.prop -anchor nw -side top  -fill x
-    pack $wi.action -side top 
-
-    frame $wi.prop.font -relief groove -bd 2
-    label $wi.prop.font.label -text "Font:"
-    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
-
-    frame $wi.prop.format -relief groove -bd 2
-    label $wi.prop.format.label -text "Effects:"
-    pack $wi.prop.font $wi.prop.format -side top -pady 2 -anchor w -fill x
-
-    # color selection 
-    if { $color == "" } {
-	set color $defTextColor
-    }
-    button $wi.prop.format.fg -text "Color" -command \
-	"popupColor fg $wi.text false"
-    checkbutton $wi.prop.format.bold -text "Bold" -variable textBold \
-	-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]
-
-    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 \
-	 $wi.prop.format.bold \
-	 $wi.prop.format.italic \
-	 $wi.prop.format.underline \
-	 -side left -pady 2 ;# -fill both
-
-    $wi.text insert end $label
-    $wi.text configure -font [list "$fontfamily" $fontsize $effects] -fg $color
-
-    $fontmenu delete 0
-    foreach f [lsort -dictionary [font families]] {
-	$fontmenu add radiobutton -value "$f" -label $f \
-	    -variable fontfamily \
-	    -command [list fontupdate $wi.text fontfamily $f]
-    }
- 
-    $sizemenu delete 0
-    foreach f {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} {
-	$sizemenu add radiobutton -value "$f" -label $f \
-	    -variable fontsize \
-	    -command [list fontupdate $wi.text fontsize $f]
-    }
- 
-    set applycmd "textConfigApply $c $wi $target "
-    set cancelcmd "destroy $wi"
-
-    button $wi.action.apply -text "Apply" -command "$applycmd"
-    button $wi.action.cancel -text "Cancel" -command "$cancelcmd"
-    bind $wi <Key-Escape> "$cancelcmd" 
-    bind $wi <Key-Return> "$applycmd"
-
-    pack $wi.action.apply $wi.action.cancel -side left ;# -fill x
-
-    after 100 {
-	focus .popup.text
-	grab .popup
-    }
-    return
-}
-
 proc fontupdate { label type args} {
     global fontfamily fontsize
     global textBold textItalic textUnderline
@@ -825,57 +798,6 @@ proc fontupdate { label type args} {
 }
 
 
-proc textConfigApply { c wi target } {
-    global annotation_list
-    global $target
-    global fontfamily fontsize textBold textItalic textUnderline
-    global changed
-
-    # new text attributes
-    set caption [string trim [$wi.text get]]
-    # set color [$wi.prop.format.fg cget -fg]
-    set color [$wi.text cget -fg]
-    set iconcoords "iconcoords"
-
-    # build the oval object
-    if { $target == 0 } {
-	# XXX what is the purpose of this?
-	xxx xxx xxx
-	set target [newObjectId "target"]
-	global $target
-	lappend annotation_list $target
-	set coords [$c coords $newtext]
-    } else {
-	set coords [getNodeCoords $target]
-    }
-	
-    set $target {}
-    lappend $iconcoords $coords
-    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}"
-    }
-
-    # draw it
-    drawText $target
-    set changed 1
-    updateUndoLog
-    redrawAll
-
-    destroy $wi 
-}
-
 # from Practical Programming in Tcl and Tk, page 190
 proc Call_Trace {{file stdout}} {
     puts $file "*** Tcl Call Trace:"
@@ -897,3 +819,4 @@ proc drawAnnotation { obj } {
 	}
     }
 }
+
diff --git a/editor.tcl b/editor.tcl
index f75cc1b..f81a128 100755
--- a/editor.tcl
+++ b/editor.tcl
@@ -1,4 +1,4 @@
-# $Id: editor.tcl,v 1.71 2007/07/20 09:22:26 marko Exp $ 
+# $Id: editor.tcl,v 1.72 2007/07/20 22:52:32 marko Exp $ 
 #
 # Copyright 2004, 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -1695,10 +1695,8 @@ proc button1-release { c x y } {
 		}
 	    }
 	}
-    } elseif {$activetool == "rectangle" } {
-	popupRectDialog $c 0 "false" "" "" ""
-    } elseif {$activetool == "oval" } {
-	popupOvalDialog $c 0 "false" "" "" ""
+    } elseif {$activetool == "rectangle" || $activetool == "oval" } {
+	popupAnnotationDialog $c 0 "false"
     } elseif {$activetool == "text" } {
 	textEnter $c $x $y
     }
@@ -2316,7 +2314,7 @@ proc popupConfigDialog { c } {
     }
     text {
 	destroy $wi
-	textConfig $c $target
+	annotationConfig $c $target
 	return
     }
     link {
@@ -3490,9 +3488,6 @@ proc selectZoom { 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"
@@ -3505,5 +3500,9 @@ proc selectZoom { x y } {
     entry $w.e1 -bg white
     $w.e1 insert 0 [expr {int($zoom * 100)}]
     pack $w.e1 -side top -pady 5 -padx 10 -fill x
+
+    update
+    focus $w.e1
+    grab $w
 }