Implement canvas renaming.

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

diff --git a/canvas.tcl b/canvas.tcl
index 8cb2408cb1495f5f17ba0f7f709f446893431caa..1c36fdd945c483e3c8d3f2a926078445819bf35c 100755 (executable)
--- a/canvas.tcl
+++ b/canvas.tcl
@@ -47,10 +47,11 @@ proc newCanvas { name } {
     set canvas [newObjectId canvas]
     global $canvas
     lappend canvas_list $canvas
+    set $canvas {}
     if { $name != "" } {
-       set $canvas [list "name $name"]
+       setCanvasName $canvas $name
     } else {
-       set $canvas [list "name Canvas[string range $canvas 1 end]"]
+       setCanvasName $canvas Canvas[string range $canvas 1 end]
     }
 
     return $canvas
@@ -60,5 +61,19 @@ proc newCanvas { name } {
 proc getCanvasName { canvas } {
     global $canvas
 
-    return [lrange [lsearch -inline [set $canvas] "name *"] 1 end]
+    set entry [lrange [lsearch -inline [set $canvas] "name *"] 1 end]
+    return [string trim $entry \{\}]
+}
+
+
+proc setCanvasName { canvas name } {
+    global $canvas
+
+    set i [lsearch [set $canvas] "name *"]
+    if { $i >= 0 } {
+       set $canvas [lreplace [set $canvas] $i $i "name {$name}"]
+    } else {
+       set $canvas [linsert [set $canvas] 1 "name {$name}"]
+    }
+    return
 }

diff --git a/editor.tcl b/editor.tcl
index 58c4c620d72762ff1f202d62ac44795bc0602297..750ad36a26b9233c0bf4c4dc2c187099ce9f8e33 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -2016,6 +2016,16 @@ proc switchCanvas { direction } {
 }
 
 
+proc renameCanvasApply { w } {
+    global curcanvas
+
+    set newname [$w.e1 get]
+    destroy $w
+    setCanvasName $curcanvas $newname
+    refreshCanvasMenu
+}
+
+
 proc refreshCanvasMenu {} {
     global canvas_list curcanvas
 
@@ -2028,6 +2038,27 @@ proc refreshCanvasMenu {} {
         updateUndoLog
         refreshCanvasMenu
     }
+    .menubar.canvas add command -label "Rename" -command {
+       set w .entry1
+       catch {destroy $w}
+       toplevel $w -takefocus 1
+       grab $w
+       wm title $w "Canvas rename"
+       wm iconname $w "Canvas rename"
+
+       label $w.msg -wraplength 5i -justify left -text "Canvas name:"
+       pack $w.msg -side top
+
+       frame $w.buttons
+       pack $w.buttons -side bottom -fill x -pady 2m
+       button $w.buttons.print -text "Apply" -command "renameCanvasApply $w"
+       button $w.buttons.cancel -text "Cancel" -command "destroy $w"
+       pack $w.buttons.print $w.buttons.cancel -side left -expand 1
+
+       entry $w.e1 -bg white
+       $w.e1 insert 0 [getCanvasName $curcanvas]
+       pack $w.e1 -side top -pady 5 -padx 10 -fill x
+    }
     .menubar.canvas add command -label "Delete" -command {
         if { [llength $canvas_list] == 1 } {
             return

diff --git a/initgui.tcl b/initgui.tcl
index 8f779ff87dc6661d1255221c599176fe9c30da2e..719e40441c508d1c9a71e2376f5370aedcb5f98d 100755 (executable)
--- a/initgui.tcl
+++ b/initgui.tcl
@@ -122,8 +122,8 @@ bind . <Control-s> "fileSaveDialogBox"
     set w .entry1
     catch {destroy $w}
     toplevel $w
-    wm title $w "IMUNES"
-    wm iconname $w "IMUNESt"
+    wm title $w "Printing options"
+    wm iconname $w "Printing options"
 
     label $w.msg -wraplength 5i -justify left -text "Print command:"
     pack $w.msg -side top