Attachment "fontchooser.tcl.patch" to
ticket [f75190db]
added by
anonymous
2021-11-21 21:41:16.
Also attachment "fontchooser.tcl.patch" to
ticket [f75190db]
added by
anonymous
2021-09-25 00:04:55.
--- fontchooser.tcl 2020-12-11 18:48:53.000000000 +0100
+++ fontchooser.tcl.bak 2021-09-25 00:33:25.547048444 +0200
@@ -12,34 +12,43 @@
variable S
set S(W) .__tk__fontchooser
- set S(fonts) [lsort -dictionary [font families]]
- set S(styles) [list \
- [::msgcat::mc "Regular"] \
- [::msgcat::mc "Italic"] \
- [::msgcat::mc "Bold"] \
- [::msgcat::mc "Bold Italic"] \
- ]
+ set S(fonts) [lsort -dictionary -unique [font families]]
+
set S(sizes) {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72}
set S(strike) 0
set S(under) 0
set S(first) 1
- set S(sampletext) [::msgcat::mc "AaBbYyZz01"]
set S(-parent) .
- set S(-title) [::msgcat::mc "Font"]
+ set S(-title) {}
set S(-command) ""
set S(-font) TkDefaultFont
}
-proc ::tk::fontchooser::Setup {} {
+proc ::tk::fontchooser::Canonical {} {
variable S
-
- # Canonical versions of font families, styles, etc. for easier searching
+
+ set S(styles) [list \
+ [::msgcat::mc Regular] \
+ [::msgcat::mc Italic] \
+ [::msgcat::mc Bold] \
+ [::msgcat::mc {Bold Italic}] \
+ ]
+ foreach style $S(styles) {lappend S(styles,lcase) [string tolower $style]}
+ set S(sizes,lcase) $S(sizes)
+ set S(sampletext) [::msgcat::mc "AaBbYyZz01"]
+
+ # Canonical versions of font families, styles, etc. for easier searching
set S(fonts,lcase) {}
foreach font $S(fonts) {lappend S(fonts,lcase) [string tolower $font]}
set S(styles,lcase) {}
foreach style $S(styles) {lappend S(styles,lcase) [string tolower $style]}
- set S(sizes,lcase) $S(sizes)
+}
+
+proc ::tk::fontchooser::Setup {} {
+ variable S
+
+ Canonical
::ttk::style layout FontchooserFrame {
Entry.field -sticky news -border true -children {
@@ -59,13 +68,22 @@
::tk::fontchooser::Setup
proc ::tk::fontchooser::Show {} {
- variable S
+ variable S
+
+
+ Canonical
+
if {![winfo exists $S(W)]} {
Create
wm transient $S(W) [winfo toplevel $S(-parent)]
tk::PlaceWindow $S(W) widget $S(-parent)
+ if {[string trim $S(-title)] eq ""} {
+ wm title $S(W) [::msgcat::mc "Font"]
+ } else {
+ wm title $S(W) $S(-title)
+ }
}
- set S(fonts) [lsort -dictionary [font families]]
+ set S(fonts) [lsort -dictionary -unique [font families]]
set S(fonts,lcase) {}
foreach font $S(fonts) { lappend S(fonts,lcase) [string tolower $font]}
wm deiconify $S(W)
@@ -105,26 +123,38 @@
return $S($option)
}
return -code error -errorcode [list TK LOOKUP OPTION $option] \
- "bad option \"$option\": must be\
+ "bad option \"$option\": must be\
-command, -font, -parent, -title or -visible"
}
-
set cache [dict create -parent $S(-parent) -title $S(-title) \
-font $S(-font) -command $S(-command)]
set r [tclParseConfigSpec [namespace which -variable S] $specs DONTSETDEFAULTS $args]
if {![winfo exists $S(-parent)]} {
- set code [list TK LOOKUP WINDOW $S(-parent)]
+ set code [list TK LOOKUP WINDOW $S(-parent)]
set err "bad window path name \"$S(-parent)\""
array set S $cache
return -code error -errorcode $code $err
}
- if {[string trim $S(-title)] eq ""} {
- set S(-title) [::msgcat::mc "Font"]
- }
- if {[winfo exists $S(W)] && ("-font" in $args)} {
- Init $S(-font)
- event generate $S(-parent) <<TkFontchooserFontChanged>>
- }
+
+ if {[winfo exists $S(W)]} {
+ if {{-font} in $args} {
+ Init $S(-font)
+ event generate $S(-parent) <<TkFontchooserFontChanged>>
+ }
+
+ if {[string trim $S(-title)] eq {}} {
+ wm title $S(W) [::msgcat::mc Font]
+ } else {
+ wm title $S(W) $S(-title)
+ }
+ if {$S(-command) eq {}} {
+ $S(W).ok configure -state disabled
+ $S(W).apply configure -state $S(nstate)
+ } else {
+ $S(W).ok configure -state $S(nstate)
+ $S(W).apply configure -state $S(nstate)
+ }
+ }
return $r
}
@@ -213,6 +243,7 @@
bind $S(W).lfonts.list <<ListboxSelect>> [namespace code [list Click font]]
bind $S(W).lstyles.list <<ListboxSelect>> [namespace code [list Click style]]
bind $S(W).lsizes.list <<ListboxSelect>> [namespace code [list Click size]]
+ bind $S(W) <<TkFontchooserFontChanged>> [list puts {Font changed}]
bind $S(W) <Alt-Key> [list ::tk::AltKeyInDialog $S(W) %A]
bind $S(W).font <<AltUnderlined>> [list ::focus $S(W).efont]
bind $S(W).style <<AltUnderlined>> [list ::focus $S(W).estyle]
@@ -233,9 +264,7 @@
grid $S(W).ok -in $bbox -sticky new -pady {0 2}
grid $S(W).cancel -in $bbox -sticky new -pady 2
- if {$S(-command) ne ""} {
- grid $S(W).apply -in $bbox -sticky new -pady 2
- }
+ grid $S(W).apply -in $bbox -sticky new -pady 2
grid columnconfigure $bbox 0 -weight 1
grid $WE.strike -sticky w -padx 10
@@ -321,6 +350,7 @@
variable S
if {$S(first) || $defaultFont ne ""} {
+ Canonical
if {$defaultFont eq ""} {
set defaultFont [[entry .___e] cget -font]
destroy .___e
@@ -377,7 +407,7 @@
variable S
set bad 0
- set nstate normal
+ set S(nstate) normal
# Make selection in each listbox
foreach var {font style size} {
set value [string tolower $S($var)]
@@ -394,13 +424,19 @@
set n [lsearch -glob $S(${var}s,lcase) "$value*"]
set bad 1
if {$var ne "size" || ! [string is double -strict $value]} {
- set nstate disabled
+ set S(nstate) disabled
}
}
$S(W).l${var}s see $n
}
if {!$bad} {Update}
- $S(W).ok configure -state $nstate
+ if {$S(-command) eq {}} {
+ $S(W).ok configure -state disabled
+ $S(W).apply configure -state $S(nstate)
+ } else {
+ $S(W).ok configure -state $S(nstate)
+ $S(W).apply configure -state $S(nstate)
+ }
}
# ::tk::fontchooser::Update --
