From f5534ea9d060d3d5b81d439bbf781a792fd9b950 Mon Sep 17 00:00:00 2001
From: ericm <ericm>
Date: Thu, 2 Mar 2000 03:02:13 +0000
Subject: * tests/clrpick.test: * library/clrpick.tcl: Added code to make color
 chooser dialog inherit screen setting from parent (bug #2334)

---
 library/choosedir.tcl |  6 +++++-
 library/clrpick.tcl   | 14 ++++++++++----
 tests/clrpick.test    | 11 +++++++++--
 3 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/library/choosedir.tcl b/library/choosedir.tcl
index 6ccbb9f..659870c 100644
--- a/library/choosedir.tcl
+++ b/library/choosedir.tcl
@@ -6,7 +6,7 @@
 # Copyright (c) 1998-2000 by Scriptics Corporation.
 # All rights reserved.
 # 
-# RCS: @(#) $Id: choosedir.tcl,v 1.3 2000/02/14 22:00:17 ericm Exp $
+# RCS: @(#) $Id: choosedir.tcl,v 1.4 2000/03/02 03:02:13 ericm Exp $
 
 # Make sure the tk::dialog namespace, in which all dialogs should live, exists
 namespace eval ::tk::dialog {}
@@ -65,6 +65,10 @@ proc ::tk::dialog::chooseDir::tkChooseDirectory { args } {
 	set opts(-parent) ""
     }
 
+    if { [string equal $opts(-initialdir) ""] } {
+	set opts(-initialdir) [pwd]
+    }
+
     set w [toplevel $opts(-parent).choosedirectory]
     wm title $w $opts(-title)
 
diff --git a/library/clrpick.tcl b/library/clrpick.tcl
index 76c2e99..72f3282 100644
--- a/library/clrpick.tcl
+++ b/library/clrpick.tcl
@@ -3,7 +3,7 @@
 #	Color selection dialog for platforms that do not support a
 #	standard color selection dialog.
 #
-# RCS: @(#) $Id: clrpick.tcl,v 1.7 1999/11/24 20:59:06 hobbs Exp $
+# RCS: @(#) $Id: clrpick.tcl,v 1.8 2000/03/02 03:02:13 ericm Exp $
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
 #
@@ -59,10 +59,16 @@ proc tkColorDialog {args} {
     tkColorDialog_Config $w $args
     tkColorDialog_InitValues $w
 
-    if {![winfo exists $w]} {
-	toplevel $w -class tkColorDialog
+    set sc [$data(-parent) cget -screen]
+    set winExists [winfo exists $w]
+    if {!$winExists || [string compare $sc [$w cget -screen]]} {
+	if {$winExists} {
+	    destroy $w
+	}
+	toplevel $w -class tkColorDialog -screen $sc
 	tkColorDialog_BuildDialog $w
     }
+
     wm transient $w $data(-parent)
 
     # 5. Withdraw the window, then update all the geometry information
@@ -82,7 +88,7 @@ proc tkColorDialog {args} {
     # may take the focus away so we can't redirect it.  Finally,
     # restore any grab that was in effect.
 
-    tkwait variable tkPriv(selectColor)
+    vwait tkPriv(selectColor)
     ::tk::RestoreFocusGrab $w $data(okBtn)
     unset data
 
diff --git a/tests/clrpick.test b/tests/clrpick.test
index e06d67d..94a99c0 100644
--- a/tests/clrpick.test
+++ b/tests/clrpick.test
@@ -5,7 +5,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: clrpick.test,v 1.4 1999/11/30 00:02:20 hobbs Exp $
+# RCS: @(#) $Id: clrpick.test,v 1.5 2000/03/02 03:02:13 ericm Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -198,7 +198,7 @@ test clrpick-2.4 {tk_chooseColor command} {nonUnixUserInteraction} {
     tk_chooseColor -parent $parent -title "Press Cancel"
 } ""
 
-set color #000000
+set color "#000000"
 test clrpick-3.1 {tk_chooseColor: background events} {nonUnixUserInteraction} {
     after 1 {set x 53}
     ToPressButton $parent ok
@@ -210,6 +210,13 @@ test clrpick-3.2 {tk_chooseColor: background events} {nonUnixUserInteraction} {
     tk_chooseColor -parent $parent -title "Press Cancel"
 } ""
 
+test clrpick-4.1 {tk_chooseColor: screen is inherited from parent} unixOnly {
+    after 50 {set ::scr [winfo screen .__tk__color]}
+    ToPressButton $parent cancel
+    tk_chooseColor -parent $parent
+    set ::scr
+} [winfo screen $parent]
+
 # cleanup
 ::tcltest::cleanupTests
 return
-- 
cgit v0.12