From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 19 Feb 2012 15:01:43 +0000 (+0000)
Subject: where-vessels: break out info-toplevel-create
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=commitdiff_plain;h=0483d963eca7e497059b7125bf5db4d6b2d53011

where-vessels: break out info-toplevel-create
---

diff --git a/yarrg/where-vessels b/yarrg/where-vessels
index eacde3a..6b1b0e2 100755
--- a/yarrg/where-vessels
+++ b/yarrg/where-vessels
@@ -1155,6 +1155,18 @@ proc draw {} {
 }
 
 
+#---------- info toplevel ----------
+
+proc info-toplevel-create {info title} {
+    toplevel $info
+    wm withdraw $info
+    wm title $info "where-vessels - $title"
+    wm protocol $info WM_DELETE_WINDOW [list wm withdraw $info]
+
+    button $info.close -text Close -command [list wm withdraw $info]
+    pack $info.close -side bottom
+}
+
 #---------- parser error reporting ----------
 
 proc parser-control-create {w base invokebuttontext etl_title} {
@@ -1171,17 +1183,11 @@ proc parser-control-create {w base invokebuttontext etl_title} {
     pack $w.resframe -side top -expand y -fill both
 
     set eb .err_$base
-    toplevel $eb
-    wm withdraw $eb
-    wm title $eb "where-vessels - $etl_title"
-    wm protocol $eb WM_DELETE_WINDOW [list wm withdraw $eb]
+    info-toplevel-create $eb $etl_title
 
     label $eb.title -text $etl_title
     pack $eb.title -side top
 
-    button $eb.close -text Close -command [list wm withdraw $eb]
-    pack $eb.close -side bottom
-
     frame $eb.emsg -bd 2 -relief groove
     label $eb.emsg.lab -anchor nw -text "Error:"
     text $eb.emsg.text -height 1