From noreply at r-forge.r-project.org Fri Dec 25 15:57:25 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Fri, 25 Dec 2015 15:57:25 +0100 (CET) Subject: [Sciviews-commits] r567 - in pkg/tcltk2: . R inst/tklibs/widget3.0 Message-ID: <20151225145725.4BE981876F7@r-forge.r-project.org> Author: phgrosjean Date: 2015-12-25 15:57:24 +0100 (Fri, 25 Dec 2015) New Revision: 567 Modified: pkg/tcltk2/DESCRIPTION pkg/tcltk2/NEWS pkg/tcltk2/R/tk2commands.R pkg/tcltk2/inst/tklibs/widget3.0/scrollw.tcl Log: Bug in tcltk2 tk2list.XXX() functions produced an error with tk2comboboxes (closes #6274) Modified: pkg/tcltk2/DESCRIPTION =================================================================== --- pkg/tcltk2/DESCRIPTION 2015-11-22 15:06:37 UTC (rev 566) +++ pkg/tcltk2/DESCRIPTION 2015-12-25 14:57:24 UTC (rev 567) @@ -1,7 +1,7 @@ Package: tcltk2 Type: Package -Version: 1.2-11 -Date: 2014-12-19 +Version: 1.2-12 +Date: 2015-12-10 Title: Tcl/Tk Additions Author: Philippe Grosjean [aut, cre] Authors at R: c(person("Philippe", "Grosjean", role = c("aut", "cre"), Modified: pkg/tcltk2/NEWS =================================================================== --- pkg/tcltk2/NEWS 2015-11-22 15:06:37 UTC (rev 566) +++ pkg/tcltk2/NEWS 2015-12-25 14:57:24 UTC (rev 567) @@ -1,5 +1,11 @@ = tcltk2 news +== Version 1.2-12 + +* A bug led to incorrect tk2list.set(), tk2list.insert() and tk2list.delete() + treatment in case of tk2combobox widgets. Corrected. + + == Version 1.2-11 * After a problem for active menu items not displayed in a contrasted color on Modified: pkg/tcltk2/R/tk2commands.R =================================================================== --- pkg/tcltk2/R/tk2commands.R 2015-11-22 15:06:37 UTC (rev 566) +++ pkg/tcltk2/R/tk2commands.R 2015-12-25 14:57:24 UTC (rev 567) @@ -20,7 +20,7 @@ tk2list.set <- function (widget, items) { ## Set a list of values for a widget (e.g., combobox) - if (inherits(widget, "ttk2combobox")) { + if (inherits(widget, "tk2combobox")) { ## ttk::combobox uses -values parameter tkconfigure(widget, values = as.character(items)) } else { @@ -36,7 +36,7 @@ tk2list.insert <- function (widget, index = "end", ...) { ## Insert one or more items in a list - if (inherits(widget, "ttk2combobox")) { + if (inherits(widget, "tk2combobox")) { ## ttk::combobox uses -values parameter Items <- as.character(unlist(list(...))) if (length(Items) < 1) return() # Nothing to insert @@ -63,7 +63,7 @@ tk2list.delete <- function (widget, first, last = first) { ## Delete one or more items from a list - if (inherits(widget, "ttk2combobox")) { + if (inherits(widget, "tk2combobox")) { ## ttk::combobox uses -values parameter List <- as.character(tcl(widget, "cget", "-values")) if (length(List) < 2 && List == "") return(List) # The list in empty Modified: pkg/tcltk2/inst/tklibs/widget3.0/scrollw.tcl =================================================================== --- pkg/tcltk2/inst/tklibs/widget3.0/scrollw.tcl 2015-11-22 15:06:37 UTC (rev 566) +++ pkg/tcltk2/inst/tklibs/widget3.0/scrollw.tcl 2015-12-25 14:57:24 UTC (rev 567) @@ -50,7 +50,8 @@ package require tile snit::widget widget::scrolledwindow { - hulltype ttk::frame + hulltype frame + #hulltype ttk::frame component hscroll component vscroll From noreply at r-forge.r-project.org Sun Dec 27 23:38:15 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 27 Dec 2015 23:38:15 +0100 (CET) Subject: [Sciviews-commits] r568 - pkg/tcltk2/inst/tklibs/khim1.0 Message-ID: <20151227223815.D96EF186CF0@r-forge.r-project.org> Author: phgrosjean Date: 2015-12-27 23:38:15 +0100 (Sun, 27 Dec 2015) New Revision: 568 Modified: pkg/tcltk2/inst/tklibs/khim1.0/.DS_Store pkg/tcltk2/inst/tklibs/khim1.0/cs.msg pkg/tcltk2/inst/tklibs/khim1.0/da.msg pkg/tcltk2/inst/tklibs/khim1.0/de.msg pkg/tcltk2/inst/tklibs/khim1.0/en.msg pkg/tcltk2/inst/tklibs/khim1.0/es.msg pkg/tcltk2/inst/tklibs/khim1.0/khim.tcl pkg/tcltk2/inst/tklibs/khim1.0/pl.msg pkg/tcltk2/inst/tklibs/khim1.0/ru.msg pkg/tcltk2/inst/tklibs/khim1.0/uk.msg Log: Changes to khim Modified: pkg/tcltk2/inst/tklibs/khim1.0/.DS_Store =================================================================== (Binary files differ) Modified: pkg/tcltk2/inst/tklibs/khim1.0/cs.msg =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/cs.msg 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/cs.msg 2015-12-27 22:38:15 UTC (rev 568) @@ -98,6 +98,9 @@ ::msgcat::mcset cs {Unicode...} "Unik?d..." ::msgcat::mcset cs {Use KHIM} "Pou??vat KHIM" + + ::msgcat::mcset cs {Do you want to save this configuration on disk?} \ + {Do you want to save this configuration on disk?} } Modified: pkg/tcltk2/inst/tklibs/khim1.0/da.msg =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/da.msg 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/da.msg 2015-12-27 22:38:15 UTC (rev 568) @@ -96,6 +96,9 @@ ::msgcat::mcset da {Unicode...} {Unicode...} ::msgcat::mcset da {Use KHIM} {Benyt KHIM} + + ::msgcat::mcset da {Do you want to save this configuration on disk?} \ + {Do you want to save this configuration on disk?} } Modified: pkg/tcltk2/inst/tklibs/khim1.0/de.msg =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/de.msg 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/de.msg 2015-12-27 22:38:15 UTC (rev 568) @@ -114,6 +114,9 @@ ::msgcat::mcset de {Unicode...} {Unicode...} ::msgcat::mcset de {Use KHIM} {Benutze KHIM} + + ::msgcat::mcset de {Do you want to save this configuration on disk?} \ + {Do you want to save this configuration on disk?} } Modified: pkg/tcltk2/inst/tklibs/khim1.0/en.msg =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/en.msg 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/en.msg 2015-12-27 22:38:15 UTC (rev 568) @@ -106,6 +106,9 @@ ::msgcat::mcset en {Unicode...} {Unicode...} ::msgcat::mcset en {Use KHIM} {Use KHIM} + + ::msgcat::mcset en {Do you want to save this configuration on disk?} \ + {Do you want to save this configuration on disk?} } Modified: pkg/tcltk2/inst/tklibs/khim1.0/es.msg =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/es.msg 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/es.msg 2015-12-27 22:38:15 UTC (rev 568) @@ -104,5 +104,8 @@ ::msgcat::mcset es {Unicode...} {Unicode...} ::msgcat::mcset es {Use KHIM} {Usar KHIM} + + ::msgcat::mcset es {Do you want to save this configuration on disk?} \ + {Do you want to save this configuration on disk?} } \ No newline at end of file Modified: pkg/tcltk2/inst/tklibs/khim1.0/khim.tcl =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/khim.tcl 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/khim.tcl 2015-12-27 22:38:15 UTC (rev 568) @@ -22,8 +22,10 @@ # #---------------------------------------------------------------------- -package require Tcl 8.4 -package require Tk 8.4 +# PhG: customized for tcltk2 to use ttk widgets + +package require Tcl 8.5 +package require Tk 8.5 package require msgcat 1.2 package require autoscroll 1.0 @@ -95,9 +97,9 @@ } # Load up message catalogs for the locale +::msgcat::mcload [file join [file dirname [info script]] msgs] +#namespace eval khim [list ::msgcat::mcload [file join[file dirname [info script]] msgs]] -namespace eval khim [list ::msgcat::mcload [file dirname [info script]]] - # Compressed table of which Unicode code points in the BMP are printable # characters. The table is read, "0x0000-0x001f are not printable, # 0x0020-0x007e are printable, 0x007f-0x009f are not printable, @@ -296,71 +298,79 @@ # Create GUI and manage geometry - checkbutton $w.v -variable ::khim::inputUse -text [mc "Use KHIM"] - label $w.l1 -text [mc "Compose key:"] - button $w.b1 -textvariable khim::inputComposeKey \ + ttk::checkbutton $w.v -variable ::khim::inputUse -text [mc "Use KHIM"] + ttk::label $w.l1 -text [mc "Compose key:"] + ttk::button $w.b1 -textvariable khim::inputComposeKey \ -command [list ::khim::GetComposeKey $w.b1] - labelframe $w.lf1 -text [mc "Key sequences"] -padx 5 -pady 5 -width 400 + #labelframe $w.lf1 -text [mc "Key sequences"] -padx 5 -pady 5 -width 400 + ttk::labelframe $w.lf1 -text [mc "Key sequences"] listbox $w.lf1.lb -height 20 -yscroll [list $w.lf1.y set] \ -font {Courier 12} -width 8 -height 10 \ - -exportselection 0 + -exportselection 0 -background [ttk::style lookup TEntry -fieldbackground] bind $w.lf1.lb <> [list ::khim::Select %W] - scrollbar $w.lf1.y -orient vertical -command [list $w.lf1.lb yview] - frame $w.lf1.f1 - label $w.lf1.f1.l1 -text [mc "Input key sequence"] + ttk::scrollbar $w.lf1.y -orient vertical -command [list $w.lf1.lb yview] + ttk::frame $w.lf1.f1 + ttk::label $w.lf1.f1.l1 -text [mc "Input key sequence"] entry $w.lf1.f1.e1 -textvariable ::khim::inputSequence -width 2 \ - -font {Courier 12} + -font {Courier 12} -background [ttk::style lookup TEntry -fieldbackground] \ + -relief flat -borderwidth 1 bind $w.lf1.f1.e1 { %W selection from 0 %W selection to end } grid $w.lf1.f1.l1 $w.lf1.f1.e1 grid columnconfigure $w.lf1.f1 2 -weight 1 - frame $w.lf1.f2 - label $w.lf1.f2.l1 -text [mc "Character"] + ttk::frame $w.lf1.f2 + ttk::label $w.lf1.f2.l1 -text [mc "Character"] entry $w.lf1.f2.e1 -textvariable ::khim::inputCharacter -width 2 \ - -font {Courier 12} + -font {Courier 12} -background [ttk::style lookup TEntry -fieldbackground] \ + -relief flat -borderwidth 1 bind $w.lf1.f2.e1 { %W selection from 0 %W selection to end } - button $w.lf1.f2.b1 -text [mc "Unicode..."] \ + ttk::button $w.lf1.f2.b1 -text [mc "Unicode..."] \ -command [list ::khim::FocusAndInsertSymbol $w.lf1.f2.e1] grid $w.lf1.f2.l1 $w.lf1.f2.e1 - grid $w.lf1.f2.b1 -row 0 -column 2 -sticky w -padx {20 0} + grid $w.lf1.f2.b1 -row 0 -column 2 -sticky w -padx {20 0} -pady 10 grid columnconfigure $w.lf1.f2 3 -weight 1 - grid $w.lf1.lb -row 0 -column 0 -sticky nsew -rowspan 5 - grid $w.lf1.y -row 0 -column 1 -sticky ns -rowspan 5 - frame $w.lf1.f3 - button $w.lf1.f3.b1 -text [mc Change] \ + grid $w.lf1.lb -row 0 -column 0 -sticky nsew -rowspan 5 -padx {5 0} -pady 5 + grid $w.lf1.y -row 0 -column 1 -sticky ns -rowspan 5 -pady 5 + ttk::frame $w.lf1.f3 + ttk::button $w.lf1.f3.b1 -text [mc Change] -width -6 \ -command [list ::khim::ChangeSequence $w] - button $w.lf1.f3.b2 -text [mc Delete] \ + ttk::button $w.lf1.f3.b2 -text [mc Delete] -width -6 \ -command [list ::khim::DeleteSequence $w] grid $w.lf1.f1 -row 0 -column 2 -sticky e -padx {20 0} grid $w.lf1.f2 -row 1 -column 2 -sticky e -padx {20 0} - grid $w.lf1.f3.b1 $w.lf1.f3.b2 -padx 5 -sticky ew + grid $w.lf1.f3.b1 $w.lf1.f3.b2 -padx 5 -sticky ew -pady 10 grid columnconfigure $w.lf1.f3 {0 1} -weight 1 -uniform A grid $w.lf1.f3 -row 3 -column 2 -sticky e -padx 20 grid rowconfigure $w.lf1 2 -weight 1 grid columnconfigure $w.lf1 3 -weight 1 ::autoscroll::autoscroll $w.lf1.y - frame $w.bf - button $w.bf.ok -text [mc OK] -command [list ::khim::OK $w] - button $w.bf.apply -text [mc Apply] -command [list ::khim::Apply $w] - button $w.bf.cancel -text [mc Cancel] -command [list destroy $w] - button $w.bf.help -text [mc Help...] \ + ttk::frame $w.bf + ttk::button $w.bf.ok -text [mc OK] -width -6 -command [list ::khim::OK $w] + ttk::button $w.bf.apply -text [mc Apply] -width -6 -command [list ::khim::Apply $w] + ttk::button $w.bf.cancel -text [mc Cancel] -width -6 -command [list destroy $w] + ttk::button $w.bf.help -text [mc Help...] -width -6 \ -command [list ::khim::showHelp $w.help] - grid $w.bf.ok -row 0 -column 0 -padx 5 -sticky ew - grid $w.bf.apply -row 0 -column 1 -padx 5 -sticky ew - grid $w.bf.cancel -row 0 -column 2 -padx 5 -sticky ew - grid $w.bf.help -row 0 -column 4 -padx 5 + #grid $w.bf.ok -row 0 -column 0 -padx 5 -sticky ew + #grid $w.bf.apply -row 0 -column 1 -padx 5 -sticky ew + #grid $w.bf.cancel -row 0 -column 2 -padx 5 -sticky ew + #grid $w.bf.help -row 0 -column 4 -padx 5 + grid $w.bf.help -row 0 -column 0 -padx {10 5} -sticky ew -pady {5 15} + grid $w.bf.cancel -row 0 -column 1 -padx 5 -sticky ew -pady {5 15} + grid $w.bf.apply -row 0 -column 2 -padx 5 -sticky ew -pady {5 15} + grid $w.bf.ok -row 0 -column 4 -padx {5 10} -pady {5 15} + grid columnconfigure $w.bf 3 -weight 1 grid columnconfigure $w.bf {0 1 2 4} -uniform A - grid $w.v -columnspan 2 -sticky w - grid $w.l1 $w.b1 -sticky w - grid $w.lf1 -columnspan 2 -sticky nsew -padx 5 -pady 5 + grid $w.v -columnspan 2 -sticky w -padx 5 -pady 10 + grid $w.l1 $w.b1 -sticky w -padx 5 -pady 10 + grid $w.lf1 -columnspan 2 -sticky nsew -padx 5 -pady 5 -ipadx 10 -ipady 10 grid $w.bf -pady 5 -sticky ew -columnspan 2 grid columnconfigure $w 1 -weight 1 @@ -444,14 +454,14 @@ if {$text eq "HELPTEXT"} { # This must be a version of Tcl that doesn't support the root # locale. Do The Right Thing anyway - set locale [::msgcat::mclocale] - ::msgcat::mclocale en + #set locale [::msgcat::mclocale] +### ::msgcat::mclocale en set text [string trim [mc HELPTEXT]] if {$text eq "HELPTEXT"} { - ::msgcat::mcload $KHIMDir + #::msgcat::mcload $KHIMDir set text [string trim [mc HELPTEXT]] } - ::msgcat::mclocale $locale +### ::msgcat::mclocale $locale } regsub -all -line {^[ \t]+} $text {} text regsub -all -line {[ \t]+$} $text {} text @@ -461,11 +471,11 @@ $w.t insert insert $text $w.t see 1.0 $w.t configure -state disabled - scrollbar $w.y -command [list $w.t yview] -orient vertical - button $w.ok -text [mc OK] -command [list destroy $w] + ttk::scrollbar $w.y -command [list $w.t yview] -orient vertical + ttk::button $w.ok -text [mc OK] -width -6 -command [list destroy $w] grid $w.t -row 0 -column 0 -sticky nsew grid $w.y -row 0 -column 1 -sticky ns - grid $w.ok -pady 5 -row 1 -column 0 -columnspan 2 + grid $w.ok -padx 10 -pady 15 -row 1 -column 0 -columnspan 2 grid rowconfigure $w 0 -weight 1 grid columnconfigure $w 0 -weight 1 @@ -525,14 +535,14 @@ if {$text eq "SELECT COMPOSE KEY"} { # This must be a version of Tcl that doesn't support the root # locale. Do The Right Thing anyway - set locale [::msgcat::mclocale] - ::msgcat::mclocale en + #set locale [::msgcat::mclocale] +### #::msgcat::mclocale en set text [string trim [mc "SELECT COMPOSE KEY"]] if {$text eq "SELECT COMPOSE KEY"} { - ::msgcat::mcload $KHIMDir + #::msgcat::mcload $KHIMDir set text [string trim [mc "SELECT COMPOSE KEY"]] } - ::msgcat::mclocale $locale +### ::msgcat::mclocale $locale } grid [label $w.l -text $text] bind $w.l [list set ::khim::inputComposeKey %K] @@ -1639,8 +1649,10 @@ set CMapInputCodePage($map) 0 set CMapCodePage($map) 0 } - grid [label $map.l1 -text [mc {Select code page:}]] \ + grid [ttk::label $map.l1 -text [mc {Select code page:}]] \ -row 0 -column 0 -sticky e + + ## PhG: if Tk 8.6, I could use ttk::spinbox grid [spinbox $map.spin -textvariable khim::CMapInputCodePage($map) \ -width 4] \ -row 0 -column 1 -sticky w @@ -1659,15 +1671,24 @@ grid [canvas $c -width 400 -height 400 \ -bg $CMapBackground($map) -takefocus 1] \ -columnspan 2 -padx 3 -pady 3 - grid [frame $map.f] -row 2 -column 0 -columnspan 2 -sticky ew -pady 3 - button $map.f.b1 -text [mc OK] -command [list khim::CMapOK $map] - button $map.f.b2 -text [mc Cancel] -command [list khim::CMapCancel $map] - button $map.f.b3 -text [mc Help...] \ + grid [ttk::frame $map.f] -row 2 -column 0 -columnspan 2 -sticky ew -pady 3 + #button $map.f.b1 -text [mc OK] -command [list khim::CMapOK $map] + #button $map.f.b2 -text [mc Cancel] -command [list khim::CMapCancel $map] + #button $map.f.b3 -text [mc Help...] \ + #-command [list khim::showHelp $map.help] + #grid $map.f.b1 -row 0 -column 0 -sticky ew -padx 5 + #grid $map.f.b2 -row 0 -column 1 -sticky ew -padx 5 + #grid $map.f.b3 -row 0 -column 3 -sticky ew -padx 5 + ttk::button $map.f.b1 -text [mc OK] -width -6 \ + -command [list khim::CMapOK $map] + ttk::button $map.f.b2 -text [mc Cancel] -width -6 \ + -command [list khim::CMapCancel $map] + ttk::button $map.f.b3 -text [mc Help...] -width -6 \ -command [list khim::showHelp $map.help] - grid $map.f.b1 -row 0 -column 0 -sticky ew -padx 5 - grid $map.f.b2 -row 0 -column 1 -sticky ew -padx 5 - grid $map.f.b3 -row 0 -column 3 -sticky ew -padx 5 - grid columnconfigure $map.f 2 -weight 1 + grid $map.f.b3 -row 0 -column 0 -sticky ew -padx 5 -pady 10 + grid $map.f.b2 -row 0 -column 2 -sticky ew -padx 5 -pady 10 + grid $map.f.b1 -row 0 -column 3 -sticky ew -padx 5 -pady 10 + grid columnconfigure $map.f 1 -weight 1 grid columnconfigure $map.f {0 1 3} -uniform A grid columnconfigure $map 1 -weight 1 Modified: pkg/tcltk2/inst/tklibs/khim1.0/pl.msg =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/pl.msg 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/pl.msg 2015-12-27 22:38:15 UTC (rev 568) @@ -104,6 +104,9 @@ ::msgcat::mcset pl {Unicode...} {Tablica Unicode...} ::msgcat::mcset pl {Use KHIM} {W??cz KHIM} + + ::msgcat::mcset pl {Do you want to save this configuration on disk?} \ + {Do you want to save this configuration on disk?} } Modified: pkg/tcltk2/inst/tklibs/khim1.0/ru.msg =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/ru.msg 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/ru.msg 2015-12-27 22:38:15 UTC (rev 568) @@ -115,6 +115,9 @@ ::msgcat::mcset ru {Unicode...} {Unicode...} ::msgcat::mcset ru {Use KHIM} {???????????? KHIM} + + ::msgcat::mcset ru {Do you want to save this configuration on disk?} \ + {Do you want to save this configuration on disk?} } Modified: pkg/tcltk2/inst/tklibs/khim1.0/uk.msg =================================================================== --- pkg/tcltk2/inst/tklibs/khim1.0/uk.msg 2015-12-25 14:57:24 UTC (rev 567) +++ pkg/tcltk2/inst/tklibs/khim1.0/uk.msg 2015-12-27 22:38:15 UTC (rev 568) @@ -108,6 +108,9 @@ ::msgcat::mcset uk {Unicode...} {Unicode...} ::msgcat::mcset uk {Use KHIM} {??????????????? KHIM} + + ::msgcat::mcset uk {Do you want to save this configuration on disk?} \ + {Do you want to save this configuration on disk?} } From noreply at r-forge.r-project.org Sun Dec 27 23:41:47 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Sun, 27 Dec 2015 23:41:47 +0100 (CET) Subject: [Sciviews-commits] r569 - in pkg/tcltk2: . R inst/tklibs inst/tklibs/choosefont inst/tklibs/choosefont/msgs inst/tklibs/khim inst/tklibs/khim/msgs man Message-ID: <20151227224147.DDC41183B39@r-forge.r-project.org> Author: phgrosjean Date: 2015-12-27 23:41:47 +0100 (Sun, 27 Dec 2015) New Revision: 569 Added: pkg/tcltk2/inst/tklibs/choosefont/ pkg/tcltk2/inst/tklibs/choosefont/choosefont.tcl pkg/tcltk2/inst/tklibs/choosefont/example.tcl pkg/tcltk2/inst/tklibs/choosefont/msgs/ pkg/tcltk2/inst/tklibs/choosefont/msgs/de.msg pkg/tcltk2/inst/tklibs/choosefont/msgs/en.msg pkg/tcltk2/inst/tklibs/choosefont/msgs/fr.msg pkg/tcltk2/inst/tklibs/choosefont/pkgIndex.tcl pkg/tcltk2/inst/tklibs/khim/ pkg/tcltk2/inst/tklibs/khim/ChangeLog pkg/tcltk2/inst/tklibs/khim/khim.man pkg/tcltk2/inst/tklibs/khim/khim.tcl pkg/tcltk2/inst/tklibs/khim/msgs/ pkg/tcltk2/inst/tklibs/khim/msgs/ROOT.msg pkg/tcltk2/inst/tklibs/khim/msgs/cs.msg pkg/tcltk2/inst/tklibs/khim/msgs/da.msg pkg/tcltk2/inst/tklibs/khim/msgs/de.msg pkg/tcltk2/inst/tklibs/khim/msgs/en.msg pkg/tcltk2/inst/tklibs/khim/msgs/es.msg pkg/tcltk2/inst/tklibs/khim/msgs/fr.msg pkg/tcltk2/inst/tklibs/khim/msgs/pl.msg pkg/tcltk2/inst/tklibs/khim/msgs/ru.msg pkg/tcltk2/inst/tklibs/khim/msgs/uk.msg pkg/tcltk2/inst/tklibs/khim/pkgIndex.tcl Removed: pkg/tcltk2/inst/tklibs/choosefont0.2/ pkg/tcltk2/inst/tklibs/khim1.0/ Modified: pkg/tcltk2/DESCRIPTION pkg/tcltk2/NAMESPACE pkg/tcltk2/NEWS pkg/tcltk2/R/tcltk2-Internal.R pkg/tcltk2/R/tk2commands.R pkg/tcltk2/R/tk2dialogs.R pkg/tcltk2/TODO pkg/tcltk2/man/setLanguage.Rd pkg/tcltk2/man/tk2dialogs.Rd Log: Locale and unicode characters for tcltk2 Modified: pkg/tcltk2/DESCRIPTION =================================================================== --- pkg/tcltk2/DESCRIPTION 2015-12-27 22:38:15 UTC (rev 568) +++ pkg/tcltk2/DESCRIPTION 2015-12-27 22:41:47 UTC (rev 569) @@ -1,7 +1,7 @@ Package: tcltk2 Type: Package -Version: 1.2-12 -Date: 2015-12-10 +Version: 1.3-0 +Date: 2015-12-27 Title: Tcl/Tk Additions Author: Philippe Grosjean [aut, cre] Authors at R: c(person("Philippe", "Grosjean", role = c("aut", "cre"), @@ -10,7 +10,7 @@ Depends: R (>= 2.8.0), tcltk Suggests: utils SystemRequirements: Tcl/Tk (>= 8.5), Tktable (>= 2.9, optional) -Description: A series of additional Tcl commands and Tk widgets with style and various functions (under Windows: DDE exchange, access to the registry and icon manipulation) to supplement the tcltk package. +Description: A series of additional Tcl commands and Tk widgets to supplement the tcltk package. License: LGPL-3 + file LICENSE -URL: http://www.sciviews.org/SciViews-R +URL: http://www.sciviews.org/recipes/tcltk/toc/ BugReports: https://r-forge.r-project.org/tracker/?group_id=194 Modified: pkg/tcltk2/NAMESPACE =================================================================== --- pkg/tcltk2/NAMESPACE 2015-12-27 22:38:15 UTC (rev 568) +++ pkg/tcltk2/NAMESPACE 2015-12-27 22:41:47 UTC (rev 569) @@ -62,6 +62,9 @@ tk2theme, tk2chooseFont, tk2swaplist, + tk2unicode_select, + tk2unicode_config, + tk2unicode_bind, tk2edit, tk2dde, tk2dde.exec, @@ -97,6 +100,9 @@ tk2font.setstyle, getLanguage, setLanguage, + tclmclocale, + tclmcset, + tclmc, tk2style, tk2dataList, tk2configList, Modified: pkg/tcltk2/NEWS =================================================================== --- pkg/tcltk2/NEWS 2015-12-27 22:38:15 UTC (rev 568) +++ pkg/tcltk2/NEWS 2015-12-27 22:41:47 UTC (rev 569) @@ -1,5 +1,19 @@ = tcltk2 news +== Version 1.3-0 + +* Message translation is completed. setLanguage()/getLanguage() work now in a + more robust way. getLanguage() separately reports the language used by R and + by Tcl/Tk, and translation catalogs for Tcl and Tk are automatically loaded + when the tcltk2 package is loaded. The new functions tclmclocale(), tclmc() + and tclmcset() complete the functions available to manage message translation + in Tcl from within R. + +* A dialog box to enter uncode characters in tk2entry or tk2text widgets and to + configure a composer to enter such unicode character on the keyboard are added + (functions tk2unicode_xxx()). + + == Version 1.2-12 * A bug led to incorrect tk2list.set(), tk2list.insert() and tk2list.delete() Modified: pkg/tcltk2/R/tcltk2-Internal.R =================================================================== --- pkg/tcltk2/R/tcltk2-Internal.R 2015-12-27 22:38:15 UTC (rev 568) +++ pkg/tcltk2/R/tcltk2-Internal.R 2015-12-27 22:41:47 UTC (rev 569) @@ -15,11 +15,18 @@ } res <- addTclPath(libdir) # extend the Tcl/Tk path - ## Make sure that Tcl/Tk locale is the same one as current R locale - lang <- getLanguage() - if (lang != "") { # Set the same language for Tcl/Tk - res <- tclRequire("msgcat") - if (inherits(res, "tclObj")) tcl("::msgcat::mclocale", lang) + ## Load Tcl and Tk translation catalogs + res <- tclRequire("msgcat") + if (inherits(res, "tclObj")) { + .Tcl("namespace import msgcat::*") + .Tcl("mcload [file join $::tcl_library msgs]") + .Tcl("mcload [file join $::tk_library msgs]") + + ## Make sure that Tcl/Tk locale is the same one as current R locale + lang <- getLanguage() + if (lang != "") { # Set the same language for Tcl/Tk + setLanguage(lang) + } } if (is.tk()) { @@ -42,7 +49,7 @@ tcl("source", file.path(libdir, "tree1.7", "tree.tcl")) ## Do we try to load the tile widgets? (only if Tcl./Tk < 8.5) - if (as.numeric(.Tcl("set ::tcl_version")) < 8.5) { + if (as.numeric(tclvalue("::tcl_version")) < 8.5) { ### tcl("source", file.path(libdir, "fonts.tcl")) ## Define fonts used in Tk (note: must be done AFTER loading tile!) ## Default values for system fonts are calculated by tile... @@ -100,25 +107,30 @@ } else if ("winnative" %in% themes) { # This must be a pre-XP windows try(tk2theme("winnative"), silent = TRUE) } else if (.isUbuntu()) { - try(tk2theme("radiance"), silent = TRUE) + #try(tk2theme("radiance"), silent = TRUE) + #We also load clearlooks by default in Ubuntu + try(tk2theme("clearlooks"), silent = TRUE) ## Special treatment for Ubuntu: change fonts to Ubuntu and Ubuntu mono ## and use white text on black for tooltips - tkfont.configure("TkDefaultFont", family = "Ubuntu", size = 11) - tkfont.configure("TkMenuFont", family = "Ubuntu", size = 11) - tkfont.configure("TkCaptionFont", family = "Ubuntu", size = 10) - tkfont.configure("TkSmallCaptionFont", family = "Ubuntu", size = 9) - tkfont.configure("TkTooltipFont", family = "Ubuntu", size = 9) - tkfont.configure("TkMenuFont", family = "Ubuntu", size = 11) - tkfont.configure("TkHeadingFont", family = "Ubuntu", size = 12) - tkfont.configure("TkIconFont", family = "Ubuntu", size = 11) - tkfont.configure("TkTextFont", family = "Ubuntu", size = 11) - tkfont.configure("TkFixedFont", family = "Ubuntu Mono", size = 11) + + ## Again, Tk 8.5/8.6 does a better job by default now than 8.4 + ## So, we don't need this any more!? + #tkfont.configure("TkDefaultFont", family = "Ubuntu", size = 11) + #tkfont.configure("TkMenuFont", family = "Ubuntu", size = 11) + #tkfont.configure("TkCaptionFont", family = "Ubuntu", size = 10) + #tkfont.configure("TkSmallCaptionFont", family = "Ubuntu", size = 9) + #tkfont.configure("TkTooltipFont", family = "Ubuntu", size = 9) + #tkfont.configure("TkMenuFont", family = "Ubuntu", size = 11) + #tkfont.configure("TkHeadingFont", family = "Ubuntu", size = 12) + #tkfont.configure("TkIconFont", family = "Ubuntu", size = 11) + #tkfont.configure("TkTextFont", family = "Ubuntu", size = 11) + #tkfont.configure("TkFixedFont", family = "Ubuntu Mono", size = 11) res <- tclRequire("tooltip") if (inherits(res, "tclObj")) { .Tcl(paste("set ::tooltip::labelOpts [list -highlightthickness 0", "-relief solid -bd 1 -background black -fg white]")) } - } else { # A modern "default" theme that fit not too bad in many situations + } else { # A modern "default" theme that fits not too bad in many situations try(tk2theme("clearlooks"), silent = TRUE) } } @@ -144,7 +156,6 @@ .onUnload <- function (libpath) { - # PhG: was .Last.lib() ## Remove all currently scheduled tasks tclTaskDelete(id = NULL) } @@ -158,16 +169,17 @@ if (inherits(theme, 'try-error')) return(FALSE) ## Try changing the tk2theme according to this value res <- try(tk2theme(theme), silent = TRUE) - return(!inherits(res, "try-error")) - } else return(FALSE) + !inherits(res, "try-error") + } else FALSE } .isUbuntu <- function () { ## Note: take care not to call 'cat' on Windows: it is usually *not* there! if (.Platform$OS.type == "windows" || grepl("^mac", .Platform$pkgType)) return(FALSE) # This is either Windows or Mac OS X! - grepl("^Ubuntu", suppressWarnings(try(system("cat /etc/issue", - intern = TRUE, ignore.stderr = TRUE), silent = TRUE))[1]) + # On Ubuntu, there is an lsb-release file, but read it just to make sure + file.exists("/etc/lsb-release") && + any(grepl("[Uu]buntu", readLines("/etc/lsb-release"))) } .mergeList <- function (l1, l2) Modified: pkg/tcltk2/R/tk2commands.R =================================================================== --- pkg/tcltk2/R/tk2commands.R 2015-12-27 22:38:15 UTC (rev 568) +++ pkg/tcltk2/R/tk2commands.R 2015-12-27 22:41:47 UTC (rev 569) @@ -435,17 +435,29 @@ return(res) } + +## Management of locales and message translation using msgcat setLanguage <- function (lang) { ## Change locale for both R and Tcl/Tk Sys.setenv(language = lang) - try(Sys.setlocale("LC_MESSAGES", lang), silent = TRUE) # Fails on Windows! + Sys.setenv(LANG = lang) + #try(Sys.setlocale("LC_MESSAGES", lang), silent = TRUE) # Fails on Windows! res <- tclRequire("msgcat") if (inherits(res, "tclObj")) { - tcl("::msgcat::mclocale", lang) - return(TRUE) + .Tcl("namespace import msgcat::*") + # If the tcl.language attribute is defined, use it + tcllang <- attr(lang, "tcl.language") + if (!is.null(tcllang) && tcllang[1] != "") { + lang <- tcllang[1] # Use only first item + } else { + # Tcl does not accept locales like en_US.UF-8: must be en_us only + lang <- tolower(sub("^([^.]+)\\..*$", "\\1", lang)) + } + tclmclocale(lang) + TRUE } else { - return(FALSE) + FALSE } } @@ -456,10 +468,42 @@ if (lang == "") lang <- Sys.getlocale("LC_MESSAGES") ## This is a bad hack that probably does not work all the time, but at least, ## it works under Windows for getting "fr" for French language - if (lang == "") lang <- tolower(substr(Sys.getlocale("LC_TIME"), 1, 2)) - return(lang) + if (lang == "") lang <- tolower(substr(Sys.getlocale("LC_COLLATE"), 1, 2)) + + ## Try to get language information from Tcl + tcllang <- try(as.character(tcl("mcpreferences")), silent = TRUE) + attr(lang, "tcl.language") <- tcllang + + lang } +tclmclocale <- function (lang) { + if (missing(lang)) { + as.character(tcl("mclocale")) + } else { + # Make sure lang is made compatible to Tcl + lang <- tolower(sub("^([^.]+)\\..*$", "\\1", lang)) + as.character(tcl("mclocale", lang)) + } +} + +tclmcset <- function(lang, msg, translation) + invisible(tclvalue(tcl("mcset", lang, msg, translation))) + +tclmc <- function (fmt, ..., domain = NULL) { + if (is.null(domain) || domain == "") { + # Simpler form + tclvalue(tcl("mc", fmt, ...)) + } else { + # Need to evaluate in 'domain' Tcl namespace + transl <- .Tcl(paste0("namespace eval ", domain, " {set ::Rtransl [mc {", + fmt, "}]}")) + sprintf(tclvalue(transl), ...) + } +} + + +## Check if Tk or Tttk aze available is.tk <- function () return(tclvalue(.Tcl("catch { package present Tk }")) == "0") Modified: pkg/tcltk2/R/tk2dialogs.R =================================================================== --- pkg/tcltk2/R/tk2dialogs.R 2015-12-27 22:38:15 UTC (rev 568) +++ pkg/tcltk2/R/tk2dialogs.R 2015-12-27 22:41:47 UTC (rev 569) @@ -12,5 +12,81 @@ { if (!is.tk()) stop("Package Tk is required but not loaded") tclRequire("choosefont") + # Make sure message translations are correctly loaded + try(tcl("mcload", system.file("tklibs", "choosefile", "msgs", + package = "tcltk2")), silent = TRUE) tcl("choosefont::choosefont", ...) } + +## Unicode character input +.tk2unicode_file <- function (app = getOption("tk2app", "R")) + file.path("~", paste0(".khimrc.", as.character(app)[1])) + +.tk2unicode_load <- function () +{ + ## Try to get current configuration + cfg <- try(tcl("::khim::getConfig"), silent = TRUE) + if (inherits(cfg, "try-error")) { + ## Try loading the khim package + res <- tclRequire("khim") + if (!inherits(res, "tclObj")) return() + ## If a config file exists, load it now + cfgfile <- .tk2unicode_file() + if (file.exists(cfgfile)) + tcl("source", cfgfile) + ## finally get the updated config + cfg <- tcl("::khim::getConfig") + } + # Make sure message translations are correctly loaded + try(tcl("mcload", system.file("tklibs", "khim", "msgs", + package = "tcltk2")), silent = TRUE) + tclvalue(cfg) +} + +tk2unicode_config <- function (parent) +{ + if (!inherits(parent, "tkwin")) + stop("'parent' must be a 'tkwin' object") + + ## Make sure khim is loaded and get its current config + cfg <- .tk2unicode_load() + + ## Display the configuration dialog box + .Tcl(paste0("::khim::getOptions ", parent$ID, ".khim")) + + ## Get the new config and compare it with the old one + cfg2 <- tclvalue(tcl("::khim::getConfig")) + if (cfg2 != cfg) { + ## Ask to save the new config + msg <- tclmc("Do you want to save this configuration on disk?", + domain = "khim") + res <- tkmessageBox( + message = msg, icon = "question", type = "yesno") + if (tclvalue(res) == "yes") { + cfgfile <- .tk2unicode_file() + cat(cfg2, file = cfgfile) + } + } +} + +tk2unicode_select <- function (widget) +{ + .tk2unicode_load() + tcl("::khim::FocusAndInsertSymbol", widget$ID) +} + +tk2unicode_bind <- function (widget) +{ + if (!inherits(widget, c("tk2text", "tk2entry"))) + stop("You can bind the unicode composer to tk2text() or tk2entry() widgets only") + ## Make sure evertything is loaded and configured correctly + .tk2unicode_load() + ## Create the binding + if (inherits(widget, "tk2text")) { + tkbindtags(widget, paste0(widget$ID , " KHIM Text ", + widget$env$parent$ID, " all")) + } else { # This must be a tk2entry widget + tkbindtags(widget, paste0(widget$ID , " KHIM Entry ", + widget$env$parent$ID, " all")) + } +} Modified: pkg/tcltk2/TODO =================================================================== --- pkg/tcltk2/TODO 2015-12-27 22:38:15 UTC (rev 568) +++ pkg/tcltk2/TODO 2015-12-27 22:41:47 UTC (rev 569) @@ -3,15 +3,11 @@ * Despite I changed ::msgcat::mclocale to de, tk2chooseFont() is still in English (but it works for fr... why?) -* tile.use(FALSE) after loading tile does not work with tk2chooseFont() - * Rework tk2edit() [takes numeric only and return characters for the moment! rework also the button bar] -* Add twapi, toolbar, tkdnd, datefield and swaplist +* Add toolbar, datefield, etc. -* Rework the code to detect and work with ActiveState install under Linux - * For the tips: select background color and font from style (same for bwidgets) * The package vignette @@ -33,14 +29,9 @@ tclvars unknown A function to display the Tcl/Tk help and additional package help from R - Use of the msgcat Tcl package - easier definition and retrieval of bindings (+ keysyms) and events - bitmap (2 colors) and image (+ IMG package? PPM/PGM and GIF by default) - cursors - experiment with focus -force! + lower/raise - font manipulation functions + homogeneity of fonts between R and Tk - styles must be handled with option! + tk_setPalette? - GUI designer for fixed place of widgets - tk/tkvars to retrieve various tk information + Easier definition and retrieval of bindings (+ keysyms) and events + Bitmap (2 colors) and image (+ IMG package? PPM/PGM and GIF by default) + Cursors + Experiment with focus -force! + lower/raise * Make a demo section Added: pkg/tcltk2/inst/tklibs/choosefont/choosefont.tcl =================================================================== --- pkg/tcltk2/inst/tklibs/choosefont/choosefont.tcl (rev 0) +++ pkg/tcltk2/inst/tklibs/choosefont/choosefont.tcl 2015-12-27 22:41:47 UTC (rev 569) @@ -0,0 +1,609 @@ +############################### +# +# a pure Tcl/Tk font chooser +# +# by ulis, 2002 +# +# NOL (No Obligation Licence) +# +# +# modifs by Martin Lemburg, 2002 +# Basic Tile'ification and msgcat support +# by schlenk, 2005 +# +# Adaptation to R and further enhancements +# by Philippe Grosjean, 2007, GNU GPL 2 or above license +############################### + +package require Tcl 8.4 +package require Tk 8.4 +package require msgcat +#package require tile 0.7.2 ;# The dialog displays tile widgets if package loaded + +namespace eval ::choosefont { + namespace import ::msgcat::mc + namespace export choosefont + + variable w .choosefont + variable font + variable listvar + variable family + variable size + variable bold + variable italic + variable underline + variable overstrike + variable ok + variable lock 1 + + variable defaultopts + + variable usetile + variable locale + set usetile 0 + set locale [::msgcat::mclocale] + + variable mnemonics + variable mnemopaths + set mnemonics {} + set mnemopaths {} + + # Get internationalization string + ::msgcat::mcload [file join [file dirname [info script]] msgs] + + # This is for correct handling of amperstand as mnemonic indicators (Alt-Key) + proc mca {widget text} { + variable mnemonics + variable mnemopaths + + foreach {newtext under} [::tk::UnderlineAmpersand [mc $text]] { + $widget configure -text $newtext -underline $under + } + # Add this info to the list of mnemonics + if {$under > -1} { + lappend mnemonics [string tolower [string index $newtext $under]] + lappend mnemopaths $widget + } + } + + # This font is inspired from tile + # Make sure that TkDefaultFont is defined + if {[lsearch [font names] TkDefaultFont] == -1} { + catch {font create TkDefaultFont} + switch -- [tk windowingsystem] { + win32 { + if {$tcl_platform(osVersion) >= 5.0} { + font configure TkDefaultFont -family "Tahoma" -size -11 + } else { + font configure TkDefaultFont -family "MS Sans Serif" -size -11 + } + } + classic - + aqua { + font configure TkDefaultFont -family "Lucida Grande" -size 13 + } + x11 { + if {![catch {tk::pkgconfig get fontsystem} fs] && $fs eq "xft"} { + font configure TkDefaultFont -family "sans-serif" -size -12 + } else { + font configure TkDefaultFont -family "Helvetica" -size -12 + } + } + } + } + + # ================ + # choose a font + # ================ + # args: + # -font an initial (and optional) font + # -title an optional title + # -fonttype 'all' (by default), 'fixed' or 'prop' + # -style do we activate additional 'style' options? + # >= 1 => 'bold' + # >= 2 => 'italic' + # >= 3 => 'underline' + # >= 4 => 'overstrike' + # -sizetype 'all' (by default), 'point', 'pixel' + # returns: + # "" if the user aborted + # or the description of the selected font + # usage: + # namespace import ::choosefont::choosefont + # choosefont "Courier 10 italic" "new font" + + proc choosefont {args} { + if {[llength $args] & 1} { + return -code error "invalid number of arguments given to choosefont (uneven number) : $args" + } + + global tcl_platform + global tile_use + + # ------------------ + # get choosefont env + # ------------------ + variable ::choosefont::w + variable ::choosefont::font + variable ::choosefont::listvarall + variable ::choosefont::listvarfixed + variable ::choosefont::listvarprop + variable ::choosefont::listvar + variable ::choosefont::family + variable ::choosefont::size + variable ::choosefont::bold + variable ::choosefont::italic + variable ::choosefont::underline + variable ::choosefont::overstrike + variable ::choosefont::ok + variable ::choosefont::usetile + variable ::choosefont::locale + variable ::choosefont::mnemonics + variable ::choosefont::mnempaths + variable ::choosefont::lock + + # ------------------ + # handling of optional arguments + # ------------------ + variable ::choosefont::defaultopts + variable opts + # Initialize de fault fonts (done only once) + if {![info exists defaultopts]} { + set defaultopts {-font "" -title "" -fonttype all -style 4 -sizetype all} + } + # Create an array (easier to work with) + array set opts $defaultopts + # Override options provided as arguments + array set opts $args + + # ------------------ + # current font + # ------------------ + if {$opts(-font) != ""} { set font $opts(-font) } + if {![info exists font]} { + # We try to get the default text or fixed font, depending on fonttype + if {$opts(-fonttype) == "fixed"} { + catch { set font [font actual TkFixedFont] } + } else { ;# 'all' or 'prop' + catch { set font [font actual TkTextFont] } + } + } + # Make sure that the default one is correct regarding 'fixed' or 'prop' + # Otherwise, select default fonts instead + if {$opts(-fonttype) == "fixed" & [font metrics $font -fixed] == 0 } { + catch { set font "courier" } + } + if {$opts(-fonttype) == "prop" & [font metrics $font -fixed] == 1 } { + catch { set font "helvetica" } + } + + # ------------------ + # dialog + # ------------------ + set notile [catch { package present tile }] + catch {if {[winfo exists $tile_use] && $tile_use == 0} {set notile 1}} + # If it is not the first time the dialog is displayed + # and tile presence, or locale has changed + # then, we destroy the dialog box and rebuild it + if {[winfo exists $w]} { + if {$notile != $usetile || [::msgcat::mclocale] != $locale} { + destroy $w + set mnemonics {} + set mnemopaths {} + } + } + set usetile $notile + set locale [::msgcat::mclocale] + + if {[winfo exists $w]} { + # show the dialog + wm deiconify $w + + # Switch to the corresponding list of fonts ('all', 'prop' or 'fixed') + switch -exact -- [string tolower $opts(-fonttype)] { + fixed { set listvar $listvarfixed } + prop { set listvar $listvarprop } + default { set listvar $listvarall } + } + + # Possibly reconfigure the size selector + if {$notile} { + switch $opts(-sizetype) { + point { + set minsize 1; set maxsize 100 + } + pixel { + set minsize -100; set maxsize -1 + } + default { + set minsize -100; set maxsize 100 + } + } + $w.fa.f.esize configure -from $minsize -to $maxsize + } else { + switch $opts(-sizetype) { + point { + $w.fa.f.esize configure -values [list 7 8 9 10 11 12 13 14 15 \ + 20 25 30 40] + } + pixel { + $w.fa.f.esize configure -values [list -20 -15 -14 -13 -12 -11 \ + -10 -9 -8] + } + default { + $w.fa.f.esize configure -values [list -20 -15 -14 -13 -12 -11 \ + -10 -9 -8 7 8 9 10 11 12 13 14 15 20 25 30 40] + } + } + } + } else { ;# Create the dialog box + if {[info exists listvarall] == 0} { + set listvarall [lsort -dictionary [font families]] + #PhG: allow to filter out fixed and/or proportional fonts + set listvarfixed {} + set listvarprop {} + foreach family $listvarall { + if {[font metrics "{$family}" -fixed] == 1 } { + lappend listvarfixed $family + } else { + lappend listvarprop $family + } + } + } + switch -exact -- [string tolower $opts(-fonttype)] { + fixed { set listvar $listvarfixed } + prop { set listvar $listvarprop } + default { set listvar $listvarall } + } + + # create the dialog + toplevel $w -class Dialog + wm resizable $w 0 0 + wm title $w [mc "Choose a font"] + wm iconname $w Dialog + wm protocol $w WM_DELETE_WINDOW { } + + # PhG: under Windows, make it topmost, so that it is always visible + if { [regexp topmost [wm attributes $w]] == 1 } { + wm attributes $w -topmost 1 + } + # Dialog boxes should be transient with respect to their parent, + # so that they will always stay on top of their parent window. However, + # some window managers will create the window as withdrawn if the parent + # window is withdrawn or iconified. Combined with the grab we put on the + # window, this can hang the entire application. Therefore we only make + # the dialog transient if the parent is viewable. + if {[winfo viewable [winfo toplevel [winfo parent $w]]] } { + wm transient $w [winfo toplevel [winfo parent $w]] + } + + if {[string equal $tcl_platform(platform) "macintosh"] + || [string equal [tk windowingsystem] "aqua"]} { + ::tk::unsupported::MacWindowStyle style $w dBoxProc + } + + # create widgets + if {$notile} { + frame $w.f -bd 1 -relief sunken + } else { + ttk::labelframe $w.f + } + # We never use tile for these ones + label $w.f.h -height 4 + label $w.f.l -textvariable ::choosefont::family + + if {$notile} { + frame $w.fl + label $w.fl.la -font TkDefaultFont + listbox $w.fl.lb -listvar ::choosefont::listvar -width 30 \ + -font TkDefaultFont -yscrollcommand [list $w.fl.sb set] \ + -selectmode single -exportselection 0 + scrollbar $w.fl.sb -command [list $w.fl.lb yview] + } else { + ttk::frame $w.fl + ttk::label $w.fl.la + listbox $w.fl.lb -listvar ::choosefont::listvar -width 30 -bd 0 \ + -font TkDefaultFont -yscrollcommand [list $w.fl.sb set] \ + -selectmode single -exportselection 0 + ttk::scrollbar $w.fl.sb -orient vertical -command [list $w.fl.lb yview] + } + mca $w.fl.la &Family: + + if {$notile} { + frame $w.fa -bd 2 -relief groove + frame $w.fa.f + label $w.fa.f.lsize -font TkDefaultFont + switch $opts(-sizetype) { + point { + set minsize 1; set maxsize 100 + } + pixel { + set minsize -100; set maxsize -1 + } + default { + set minsize -100; set maxsize 100 + } + } + spinbox $w.fa.f.esize -textvariable ::choosefont::size -width 3 \ + -validate focusout -vcmd {string is integer -strict %P} \ + -from $minsize -to $maxsize -font TkDefaultFont + checkbutton $w.fa.f.bold -variable ::choosefont::bold \ + -font TkDefaultFont + checkbutton $w.fa.f.italic -variable ::choosefont::italic \ + -font TkDefaultFont + checkbutton $w.fa.f.under -variable ::choosefont::underline \ + -font TkDefaultFont + checkbutton $w.fa.f.over -variable ::choosefont::overstrike \ + -font TkDefaultFont + } else { + ttk::labelframe $w.fa + ttk::frame $w.fa.f + ttk::label $w.fa.f.lsize + ttk::combobox $w.fa.f.esize -textvariable ::choosefont::size \ + -width 3 -exportselection 0 + switch $opts(-sizetype) { + point { + $w.fa.f.esize configure -values [list 7 8 9 10 11 12 13 14 15 \ + 20 25 30 40] + } + pixel { + $w.fa.f.esize configure -values [list -20 -15 -14 -13 -12 -11 \ + -10 -9 -8] + } + default { + $w.fa.f.esize configure -values [list -20 -15 -14 -13 -12 -11 \ + -10 -9 -8 7 8 9 10 11 12 13 14 15 20 25 30 40] + } + } + ttk::checkbutton $w.fa.f.bold -variable ::choosefont::bold + ttk::checkbutton $w.fa.f.italic -variable ::choosefont::italic + ttk::checkbutton $w.fa.f.under -variable ::choosefont::underline + ttk::checkbutton $w.fa.f.over -variable ::choosefont::overstrike + } + mca $w.fa.f.lsize &Size: + mca $w.fa.f.bold &Bold + mca $w.fa.f.italic &Italic + mca $w.fa.f.under &Underline + mca $w.fa.f.over &Overstrike + + if {$notile} { + frame $w.fb + button $w.fb.ok -text [mc OK] -width 10 \ + -command { set ::choosefont::ok 1 } -font TkDefaultFont + button $w.fb.cancel -text [mc Cancel] -width 10 \ + -command { set ::choosefont::ok 0 } -font TkDefaultFont + } else { + ttk::frame $w.fb + ttk::button $w.fb.ok -text [mc OK] -width 10 \ + -command { set ::choosefont::ok 1 } + ttk::button $w.fb.cancel -text [mc Cancel] -width 10 \ + -command { set ::choosefont::ok 0 } + } + wm protocol $w WM_DELETE_WINDOW { $::choosefont::w.fb.cancel invoke } + + # bind events + bind $w.fl.lb { + set ::choosefont::family [%W get [%W cursel]] + focus %W + } + + # listbox handling + bind $w { ::choosefont::selectfont %W First } + bind $w { ::choosefont::selectfont %W Last } + bind $w { ::choosefont::selectfont %W First } + bind $w { ::choosefont::selectfont %W Last } + bind $w { ::choosefont::selectfont %W PgDown } + bind $w { ::choosefont::selectfont %W PgUp } + bind $w { ::choosefont::selectfont %W %K } + + # buttons handling + bind $w [list $w.fb.cancel invoke] + bind $w [list $w.fb.ok invoke] + + # Alt-key navigation + if {[llength $mnemonics] > 0} { + bind $w { + set w [winfo toplevel %W] + set key [string tolower %K] + set pos [lsearch $::choosefont::mnemonics $key] + if {$pos > -1} { + set target [lindex $::choosefont::mnemopaths $pos] + event generate $target <> + } + } + } + bind $w.fl.la <> [list focus $w.fl.lb] + bind $w.fa.f.lsize <> { focus $w.fa.f.esize } + bind $w.fa.f.bold <> { + $w.fa.f.bold invoke; focus $w.fa.f.bold } + bind $w.fa.f.italic <> { + $w.fa.f.italic invoke; focus $w.fa.f.italic } + bind $w.fa.f.under <> { + $w.fa.f.under invoke; focus $w.fa.f.under } + bind $w.fa.f.over <> { + $w.fa.f.over invoke; focus $w.fa.f.over } + + set lock 1 + + trace variable ::choosefont::family w ::choosefont::createfont + trace variable ::choosefont::size w ::choosefont::createfont + trace variable ::choosefont::bold w ::choosefont::createfont + trace variable ::choosefont::italic w ::choosefont::createfont + trace variable ::choosefont::underline w ::choosefont::createfont + trace variable ::choosefont::overstrike w ::choosefont::createfont + + # place widgets + grid $w.f -row 0 -column 0 -columnspan 2 -sticky nsew -pady {2 5} + grid $w.fl -row 1 -column 0 -padx 5 -pady 5 + grid $w.fa -row 1 -column 1 -sticky nsew -padx 5 -pady 5 + grid $w.fb -row 2 -column 0 -columnspan 2 -sticky ew -pady 7 + grid $w.f.h -row 0 -column 0 + grid $w.f.l -row 0 -column 1 -sticky nsew -pady 3 + grid $w.fl.la -row 0 -column 0 -sticky nw -pady 3 + grid $w.fl.lb -row 1 -column 0 + grid $w.fl.sb -row 1 -column 1 -sticky ns + grid $w.fa.f -padx 5 -pady 5 + grid $w.fa.f.lsize -row 0 -column 0 -padx 5 -pady 10 -sticky w + grid $w.fa.f.esize -row 0 -column 1 -sticky w + grid $w.fa.f.bold -row 1 -column 0 -columnspan 2 -sticky w + grid $w.fa.f.italic -row 2 -column 0 -columnspan 2 -sticky w + grid $w.fa.f.under -row 3 -column 0 -columnspan 2 -sticky w + grid $w.fa.f.over -row 4 -column 0 -columnspan 2 -sticky w + grid $w.fb.ok $w.fb.cancel -padx 20 + # Center the Window on screen the first time it is used + ::tk::PlaceWindow $w + } + + # Reconfigure the dialog box with current font + set family [font actual $font -family] + set size [font actual $font -size] + set bold [expr {[font actual $font -weight] == "bold"}] + if {$opts(-style) > 0} { # Allow bold + $w.fa.f.bold configure -state normal + } else { + $w.fa.f.bold configure -state disabled + } + set italic [expr {[font actual $font -slant] == "italic"}] + if {$opts(-style) > 1} { # Allow italic + $w.fa.f.italic configure -state normal + } else { + $w.fa.f.italic configure -state disabled + } + set underline [font actual $font -underline] + if {$opts(-style) > 2} { # Allow underline + $w.fa.f.under configure -state normal + } else { + $w.fa.f.under configure -state disabled + } + set overstrike [font actual $font -overstrike] + if {$opts(-style) > 3} { # Allow overstrike + $w.fa.f.over configure -state normal + } else { + $w.fa.f.over configure -state disabled + } + + set lock 0 + ::choosefont::createfont + + # ------------------ + # end of dialog + # ------------------ + + if {$opts(-title) != ""} { + wm title $w $opts(-title) + } else { + wm title $w [mc "Choose a font"] + } + set newIndex [lsearch -exact $listvar $family] + # PhG: clear the selection list first! + $w.fl.lb selection clear 0 end + # PhG: this is needed by R, otherwise, there is a bug with the list + update + $w.fl.lb selection set $newIndex + $w.fl.lb activate $newIndex + $w.fl.lb see $newIndex + # PhG: focus on the list + focus $w.fl.lb + + # Grab the focus, wait for user action + ::tk::SetFocusGrab $w $w.fl.lb + vwait ::choosefont::ok + # Restore the focus and hide the font chooser dialog box + ::tk::RestoreFocusGrab $w $w.fl.lb withdraw + + if {$ok} { + return [::choosefont::createfont] + } else { + return "" + } + } + + # ================ + # ancillary procs + # ================ + proc selectfont {w mode} { + if {[winfo class $w] != "Listbox"} { return } + + set oldIndex [$w curselection] + + if {[string length $mode] > 1} { [TRUNCATED] To get the complete diff run: svnlook diff /svnroot/sciviews -r 569