git-gui: Save geometry before the window layout is damaged

Because Tk does not assure us the order that it will process
children in before it destroys the main toplevel we cannot safely
save our geometry data during a "bind . <Destroy>" event binding.
The geometry may have already changed as a result of a one or
more children being removed from the layout.  This was pointed
out in gitk by Mark Levedahl, and patched over there by commit
b6047c5a8166a71e01c6b63ebbb67c6894d95114.

So we now also use "wm protocol . WM_DELETE_WINDOW" to detect when
the window is closed by the user, and forward that close event to
our main do_quit routine.

Signed-off-by: Shawn O. Pearce <spearce@spearce.org>

5 files changed, 25 insertions, 8 deletions

diff --git a/lib/blame.tcl b/lib/blame.tcl
index 98687c7..139171d 100644
--- a/lib/blame.tcl
+++ b/lib/blame.tcl
@@ -289,7 +289,6 @@ constructor new {i_commit i_path} {
 
 	bind $w_cviewer <Button-1> [list focus $w_cviewer]
 	bind $top <Visibility> [list focus $top]
-	bind $w_file <Destroy> [list delete_this $this]
 
 	grid configure $w.header -sticky ew
 	grid configure $w.file_pane -sticky nsew
diff --git a/lib/browser.tcl b/lib/browser.tcl
index fd86b11..3d6341b 100644
--- a/lib/browser.tcl
+++ b/lib/browser.tcl
@@ -70,7 +70,6 @@ constructor new {commit} {
 	bind $w_list <Right>           break
 
 	bind $w_list <Visibility> [list focus $w_list]
-	bind $w_list <Destroy> [list delete_this $this]
 	set w $w_list
 	_ls $this $browser_commit
 	return $this
diff --git a/lib/class.tcl b/lib/class.tcl
index 72494c1..9d298d0 100644
--- a/lib/class.tcl
+++ b/lib/class.tcl
@@ -120,10 +120,21 @@ proc delete_this {{t {}}} {
 	if {[namespace exists $t]} {namespace delete $t}
 }
 
-proc make_toplevel {t w} {
-	upvar $t top $w pfx
+proc make_toplevel {t w args} {
+	upvar $t top $w pfx this this
+
+	if {[llength $args] % 2} {
+		error "make_toplevel topvar winvar {options}"
+	}
+	set autodelete 1
+	foreach {name value} $args {
+		switch -exact -- $name {
+		-autodelete {set autodelete $value}
+		default     {error "unsupported option $name"}
+		}
+	}
+
 	if {[winfo ismapped .]} {
-		upvar this this
 		regsub -all {::} $this {__} w
 		set top .$w
 		set pfx $top
@@ -132,6 +143,13 @@ proc make_toplevel {t w} {
 		set top .
 		set pfx {}
 	}
+
+	if {$autodelete} {
+		wm protocol $top WM_DELETE_WINDOW "
+			[list delete_this $this]
+			[list destroy $top]
+		"
+	}
 }
 
 
diff --git a/lib/console.tcl b/lib/console.tcl
index 8c112f3..ce25d92 100644
--- a/lib/console.tcl
+++ b/lib/console.tcl
@@ -17,7 +17,7 @@ constructor new {short_title long_title} {
 
 method _init {} {
 	global M1B
-	make_toplevel top w
+	make_toplevel top w -autodelete 0
 	wm title $top "[appname] ([reponame]): $t_short"
 	set console_cr 1.0
 
diff --git a/lib/merge.tcl b/lib/merge.tcl
index 24ed24b..ae0389d 100644
--- a/lib/merge.tcl
+++ b/lib/merge.tcl
@@ -125,7 +125,8 @@ Please select fewer branches.  To merge more than 15 branches, merge the branche
 	set cons [console::new "Merge" $msg]
 	console::exec $cons $cmd \
 		[namespace code [list _finish $revcnt $cons]]
-	bind $w <Destroy> {}
+
+	wm protocol $w WM_DELETE_WINDOW {}
 	destroy $w
 }
 
@@ -250,7 +251,7 @@ proc dialog {} {
 	bind $w <$M1B-Key-Return> $_start
 	bind $w <Visibility> "grab $w; focus $w.source.l"
 	bind $w <Key-Escape> "unlock_index;destroy $w"
-	bind $w <Destroy> unlock_index
+	wm protocol $w WM_DELETE_WINDOW "unlock_index;destroy $w"
 	wm title $w "[appname] ([reponame]): Merge"
 	tkwait window $w
 }