summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorfvogel <fvogelnew1@free.fr>2020-11-07 18:18:03 (GMT)
committerfvogel <fvogelnew1@free.fr>2020-11-07 18:18:03 (GMT)
commit6133a711414cfb8fcc3a8b52ecf25b59a09e5800 (patch)
tree52b45efd5bcd6e0643d09db1a983ac391f7dc24e
parent78fe050165a475fd7c74463a8f30ad1ba30e7fdd (diff)
parent5c53cd20a9fb061ca2f2e8bd5695a67302cdd5d4 (diff)
downloadtk-6133a711414cfb8fcc3a8b52ecf25b59a09e5800.zip
tk-6133a711414cfb8fcc3a8b52ecf25b59a09e5800.tar.gz
tk-6133a711414cfb8fcc3a8b52ecf25b59a09e5800.tar.bz2
Fix [4ebcc04dc4]: tk fontchooser partial configure on X11 overwrites options not specified.
-rw-r--r--library/comdlg.tcl9
-rw-r--r--library/fontchooser.tcl2
-rw-r--r--tests/fontchooser.test8
3 files changed, 14 insertions, 5 deletions
diff --git a/library/comdlg.tcl b/library/comdlg.tcl
index 3dd03dc..0a7f65b 100644
--- a/library/comdlg.tcl
+++ b/library/comdlg.tcl
@@ -29,7 +29,8 @@
# {....}
# }
#
-# flags = currently unused.
+# flags = a list of flags. Currently supported flags are:
+# DONTSETDEFAULTS = skip default values setting
#
# argList = The list of "-option value" pairs.
#
@@ -63,8 +64,10 @@ proc tclParseConfigSpec {w specs flags argList} {
# 2: set the default values
#
- foreach cmdsw [array names cmd] {
- set data($cmdsw) $def($cmdsw)
+ if {"DONTSETDEFAULTS" ni $flags} {
+ foreach cmdsw [array names cmd] {
+ set data($cmdsw) $def($cmdsw)
+ }
}
# 3: parse the argument list
diff --git a/library/fontchooser.tcl b/library/fontchooser.tcl
index a9bd706..9d49c57 100644
--- a/library/fontchooser.tcl
+++ b/library/fontchooser.tcl
@@ -111,7 +111,7 @@ proc ::tk::fontchooser::Configure {args} {
set cache [dict create -parent $S(-parent) -title $S(-title) \
-font $S(-font) -command $S(-command)]
- set r [tclParseConfigSpec [namespace which -variable S] $specs "" $args]
+ set r [tclParseConfigSpec [namespace which -variable S] $specs DONTSETDEFAULTS $args]
if {![winfo exists $S(-parent)]} {
set code [list TK LOOKUP WINDOW $S(-parent)]
set err "bad window path name \"$S(-parent)\""
diff --git a/tests/fontchooser.test b/tests/fontchooser.test
index f36ddf2..a149ccb 100644
--- a/tests/fontchooser.test
+++ b/tests/fontchooser.test
@@ -11,7 +11,7 @@ testConstraint failsOnUbuntuNoXft [expr {[testConstraint failsOnUbuntu] || (![ca
# the following helper functions are related to the functions used
# in winDialog.test where they are used to send messages to the win32
-# dialog (hence the wierdness).
+# dialog (hence the weirdness).
proc start {cmd} {
set ::tk_dialog {}
@@ -193,6 +193,12 @@ test fontchooser-4.4 {fontchooser -font} -constraints {scriptImpl failsOnUbuntuN
lrange $::testfont 1 end
} -result {14 bold}
+test fontchooser-5.1 {fontchooser multiple configure} -constraints {scriptImpl} -body {
+ tk fontchooser configure -title TestTitle -command foo
+ tk fontchooser configure -command bar
+ tk fontchooser configure -title
+} -result {TestTitle}
+
# -------------------------------------------------------------------------
cleanupTests