summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>2000-03-02 03:02:13 (GMT)
committerericm <ericm>2000-03-02 03:02:13 (GMT)
commitf5534ea9d060d3d5b81d439bbf781a792fd9b950 (patch)
treee4711d8e6bdf036a7da62c6cf9c35b20d05802ce
parent9ddd72d5fb7e050ceacbb03b2b3ab4a6bc01d40e (diff)
downloadtk-f5534ea9d060d3d5b81d439bbf781a792fd9b950.zip
tk-f5534ea9d060d3d5b81d439bbf781a792fd9b950.tar.gz
tk-f5534ea9d060d3d5b81d439bbf781a792fd9b950.tar.bz2
* tests/clrpick.test:
* library/clrpick.tcl: Added code to make color chooser dialog inherit screen setting from parent (bug #2334)
-rw-r--r--library/choosedir.tcl6
-rw-r--r--library/clrpick.tcl14
-rw-r--r--tests/clrpick.test11
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