From: marko <marko>
Date: Fri, 4 Nov 2005 11:39:31 +0000 (+0000)
Subject: Implement canvas renaming.
X-Git-Url: https://git.entuzijast.net/?a=commitdiff_plain;h=d142a721767f37fb97103352e570b4a4b81d8a00;p=imunes.git

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 8cb2408..1c36fdd 100755
--- 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 58c4c62..750ad36 100755
--- 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 8f779ff..719e404 100755
--- 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