[Sciviews-commits] r541 - in pkg/tcltk2: . R inst/tklibs/ttktheme_radiance man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 11 17:03:40 CET 2013
Author: phgrosjean
Date: 2013-12-11 17:03:40 +0100 (Wed, 11 Dec 2013)
New Revision: 541
Added:
pkg/tcltk2/R/tk2swaplist.R
Modified:
pkg/tcltk2/DESCRIPTION
pkg/tcltk2/NEWS
pkg/tcltk2/R/tk2commands.R
pkg/tcltk2/R/tk2widgets.R
pkg/tcltk2/inst/tklibs/ttktheme_radiance/pkgIndex.tcl
pkg/tcltk2/man/tcltk2-package.Rd
Log:
Bug correction: invisible caret in text widget. Further tweaking of field background colour for those widgets that require it.
Modified: pkg/tcltk2/DESCRIPTION
===================================================================
--- pkg/tcltk2/DESCRIPTION 2013-12-05 14:59:07 UTC (rev 540)
+++ pkg/tcltk2/DESCRIPTION 2013-12-11 16:03:40 UTC (rev 541)
@@ -1,7 +1,7 @@
Package: tcltk2
Type: Package
-Version: 1.2-8
-Date: 2013-12-05
+Version: 1.2-9
+Date: 2013-12-11
Title: Tcl/Tk Additions
Authors at R: c(person("Philippe", "Grosjean", role = c("aut", "cre"),
email = "phgrosjean at sciviews.org"))
Modified: pkg/tcltk2/NEWS
===================================================================
--- pkg/tcltk2/NEWS 2013-12-05 14:59:07 UTC (rev 540)
+++ pkg/tcltk2/NEWS 2013-12-11 16:03:40 UTC (rev 541)
@@ -1,5 +1,15 @@
= tcltk2 news
+== Version 1.2-9
+
+* New theme handling introduced in version 1.2-8 resulted in an invisible caret
+ in text widget.
+
+* Further tweaking of color themes: now fieldbackground for entry, combobox,
+ canvas, listbox, mclistbox, tablelist, spinbox, text and ctext widgets (build
+ using old Tk widgets or megawidgets) now default with the correct theme color.
+
+
== Version 1.2-8
* A better handling of fonts and colors for Tk widgets according to themes used
Modified: pkg/tcltk2/R/tk2commands.R
===================================================================
--- pkg/tcltk2/R/tk2commands.R 2013-12-05 14:59:07 UTC (rev 540)
+++ pkg/tcltk2/R/tk2commands.R 2013-12-11 16:03:40 UTC (rev 541)
@@ -229,18 +229,20 @@
"activeForeground", afg,
"disabledForeground",
tclvalue(.Tcl("ttk::style lookup TLabel -foreground disabled")),
- "highlightBackground",
- tclvalue(.Tcl("ttk::style lookup TLabel -background focus")),
+ "highlightBackground", "white",
+ #tclvalue(.Tcl("ttk::style lookup TLabel -background focus")),
"highlightColor", ffg,
"insertBackground",
- tclvalue(.Tcl("ttk::style lookup TLabel -background active")),
+ tclvalue(.Tcl("ttk::style lookup TLabel -foreground active")),
"selectBackground",
tclvalue(.Tcl("ttk::style lookup TText -selectbackground")),
"selectForeground",
tclvalue(.Tcl("ttk::style lookup TText -selectforeground")),
"selectColor",
tclvalue(.Tcl("ttk::style lookup TText -selectforeground")),
- "throughColor", hfg))
+ "throughColor", hfg),
+ "fieldBackground",
+ tclvalue(.Tcl("ttk::style lookup TEntry -fieldbackground")))
## Set menu font the same as label font
font <- tclvalue(.Tcl("ttk::style lookup TLabel -font"))
Added: pkg/tcltk2/R/tk2swaplist.R
===================================================================
--- pkg/tcltk2/R/tk2swaplist.R (rev 0)
+++ pkg/tcltk2/R/tk2swaplist.R 2013-12-11 16:03:40 UTC (rev 541)
@@ -0,0 +1,23 @@
+tk2swaplist <- function(items, selection, title = "Select items", ...)
+{
+ win <- tktoplevel()
+ res <- try(tclRequire("swaplist"), silent = TRUE)
+ if (inherits(res, "try-error"))
+ stop("swaplist Tcl package not available")
+ sel <- tclVar()
+ res <- tcl("swaplist::swaplist", win, sel, items, selection,
+ title = title, ...)
+ if (tclvalue(res) == 0) { # User cancelled
+ res <- character(0)
+ } else res <- tclObj(sel)
+ if (is.ordered(items))
+ return(ordered(as.character(res), levels = levels(items)))
+ if (is.factor(items))
+ return(factor(as.character(res), levels = levels(items)))
+ switch(typeof(items),
+ integer = as.integer(res),
+ double = as.numeric(res),
+ logical = as.logical(res),
+ complex = as.complex(res),
+ as.character(res))
+}
Modified: pkg/tcltk2/R/tk2widgets.R
===================================================================
--- pkg/tcltk2/R/tk2widgets.R 2013-12-05 14:59:07 UTC (rev 540)
+++ pkg/tcltk2/R/tk2widgets.R 2013-12-11 16:03:40 UTC (rev 541)
@@ -27,7 +27,13 @@
{
if (!is.ttk()) stop("Tcl/Tk >= 8.5 is required")
### TODO: use autoscroll here!
- w <- tkwidget(parent, "canvas", ...)
+ ## Default background to fieldbackground
+ if (any(names(list(...)) == "background")) {
+ w <- tkwidget(parent, "canvas", ...)
+ } else {
+ w <- tkwidget(parent, "canvas",
+ background = .Tcl("ttk::style lookup TEntry -fieldbackground"), ...)
+ }
if (tip != "") tk2tip(w, tip)
class(w) <- c("tk2canvas", "tk2widget", class(w))
return(w)
@@ -154,37 +160,41 @@
w <- tkwidget(parent, "listbox", font = "TkDefaultFont",
borderwidth = 1, relief = "sunken", activestyle = "dotbox",
selectmode = selectmode, height = height, exportselection = 0,
- background = "#ffffff", ...)
+ background = .Tcl("ttk::style lookup TEntry -fieldbackground"), ...)
} else { # We need to create a tk2frame as parent of the listbox
wf <- tk2frame(parent)
w <- tkwidget(wf, "listbox", font = "TkDefaultFont",
borderwidth = 1, relief = "sunken", activestyle = "dotbox",
selectmode = selectmode, height = height, exportselection = 0,
- background = "#ffffff", ...)
+ background = .Tcl("ttk::style lookup TEntry -fieldbackground"), ...)
}
## Make it react to tk2theme changes, and integrate the listbox as much
## as possible with current ttk theme
+ #restyleListbox <- function (W) {
+ # ## Restyle the listbox according to current ttk style
+ # ## Note: font is set to TkDefaultFont => already managed there!
+ # tkconfigure(W,
+ # foreground = tk2style("tk2entry", "foreground",
+ # default = "#000000"),
+ # borderwidth = tk2style("", "borderwidth", default = 0),
+ # disabledforeground = tk2style("tk2entry", "foreground",
+ # "disabled", default = "#a3a3a3"),
+ # highlightbackground = tk2style("tk2entry", "selectbackground",
+ # default = "#c3c3c3"),
+ # highlightcolor = tk2style("tk2entry", "selectbackground",
+ # default = "#c3c3c3"),
+ # selectbackground = tk2style("tk2entry", "selectbackground",
+ # default = "#c3c3c3"),
+ # selectforeground = tk2style("tk2entry", "selectforeground",
+ # default = "#ffffff")
+ # )
+ #}
+ ## Restyle it now
+ #restyleListbox(w)
restyleListbox <- function (W) {
- ## Restyle the listbox according to current ttk style
- ## Note: font is set to TkDefaultFont => already managed there!
- tkconfigure(W,
- foreground = tk2style("tk2entry", "foreground",
- default = "#000000"),
- borderwidth = tk2style("", "borderwidth", default = 0),
- disabledforeground = tk2style("tk2entry", "foreground",
- "disabled", default = "#a3a3a3"),
- highlightbackground = tk2style("tk2entry", "selectbackground",
- default = "#c3c3c3"),
- highlightcolor = tk2style("tk2entry", "selectbackground",
- default = "#c3c3c3"),
- selectbackground = tk2style("tk2entry", "selectbackground",
- default = "#c3c3c3"),
- selectforeground = tk2style("tk2entry", "selectforeground",
- default = "#ffffff")
- )
+ tkconfigure(W, background =
+ .Tcl("ttk::style lookup TEntry -fieldbackground"))
}
- ## Restyle it now
- restyleListbox(w)
## If there are values and/or selections, populate the list now
for (item in values)
@@ -229,7 +239,8 @@
res <- tclRequire("mclistbox")
if (!inherits(res, "tclObj"))
stop("Impossible to load the Tcl mclistbox package; check your Tcl/Tk installation")
- w <- tkwidget(parent, "mclistbox::mclistbox", font = "TkDefaultFont", ...)
+ w <- tkwidget(parent, "mclistbox::mclistbox", font = "TkDefaultFont",
+ background = .Tcl("ttk::style lookup TEntry -fieldbackground"), ...)
tkconfigure(w, relief = "flat")
if (tip != "") tk2tip(w, tip)
class(w) <- c("tk2mclistbox", "tk2widget", class(w))
@@ -342,8 +353,16 @@
tk2spinbox <- function (parent, tip = "", ...)
{
if (!is.ttk()) stop("Tcl/Tk >= 8.5 is required")
- w <- tkwidget(parent, "spinbox", font = "TkDefaultFont",
- relief = "solid", borderwidth = 1, ...)
+ ## Default background to fieldbackground
+ if (any(names(list(...)) == "background")) {
+ w <- tkwidget(parent, "spinbox", font = "TkDefaultFont",
+ relief = "solid", borderwidth = 1, ...)
+ } else {
+ w <- tkwidget(parent, "spinbox", font = "TkDefaultFont",
+ relief = "solid", borderwidth = 1,
+ background = .Tcl("ttk::style lookup TEntry -fieldbackground"), ...)
+ }
+
if (tip != "") tk2tip(w, tip)
class(w) <- c("tk2spinbox", "tk2widget", class(w))
return(w)
@@ -366,8 +385,17 @@
if (!is.ttk())
stop("Tcl/Tk >= 8.5 is required")
if (inherits(tclRequire("tablelist_tile", warn = FALSE), "tclObj")) {
- w <- tkwidget(parent, "tablelist::tablelist", font = "TkDefaultFont",
- ...)
+ ## Default background to fieldbackground
+ if (any(names(list(...)) == "background")) {
+ w <- tkwidget(parent, "tablelist::tablelist",
+ font = "TkDefaultFont", ...)
+ } else {
+ w <- tkwidget(parent, "tablelist::tablelist",
+ font = "TkDefaultFont",
+ background = .Tcl("ttk::style lookup TEntry -fieldbackground"),
+ ...)
+ }
+
class(w) <- c("tk2tablelist", "tk2widget", class(w))
return(w)
}
@@ -378,7 +406,15 @@
{
### TODO: autohide scrollbars
if (!is.ttk()) stop("Tcl/Tk >= 8.5 is required")
- w <- tkwidget(parent, "text", font = "TkTextFont", ...)
+
+ ## Default background to fieldbackground
+ if (any(names(list(...)) == "background")) {
+ w <- tkwidget(parent, "text", font = "TkTextFont", ...)
+ } else {
+ w <- tkwidget(parent, "text", font = "TkTextFont",
+ background = .Tcl("ttk::style lookup TEntry -fieldbackground"), ...)
+ }
+
tkconfigure(w, relief = "flat")
if (tip != "") tk2tip(w, tip)
class(w) <- c("tk2text", "tk2widget", class(w))
@@ -390,7 +426,15 @@
### TODO: autohide scrollbars
if (!is.ttk()) stop("Tcl/Tk >= 8.5 is required")
tclRequire("ctext")
- w <- tkwidget(parent, "ctext", font = "TkFixedFont", ...)
+
+ ## Default background to fieldbackground
+ if (any(names(list(...)) == "background")) {
+ w <- tkwidget(parent, "ctext", font = "TkFixedFont", ...)
+ } else {
+ w <- tkwidget(parent, "ctext", font = "TkFixedFont",
+ background = .Tcl("ttk::style lookup TEntry -fieldbackground"), ...)
+ }
+
tkconfigure(w, relief = "flat")
if (tip != "") tk2tip(w, tip)
class(w) <- c("tk2ctext", "tk2widget", class(w))
Modified: pkg/tcltk2/inst/tklibs/ttktheme_radiance/pkgIndex.tcl
===================================================================
--- pkg/tcltk2/inst/tklibs/ttktheme_radiance/pkgIndex.tcl 2013-12-05 14:59:07 UTC (rev 540)
+++ pkg/tcltk2/inst/tklibs/ttktheme_radiance/pkgIndex.tcl 2013-12-11 16:03:40 UTC (rev 541)
@@ -5,7 +5,7 @@
package ifneeded ttk::theme::radiance 0.1 \
[list source [file join $dir radiance8.5.tcl]]
} else {
- package ifneeded tile::theme::clearlooks 0.1 \
+ package ifneeded tile::theme::radiance 0.1 \
[list source [file join $dir radiance8.4.tcl]]
}
}
Modified: pkg/tcltk2/man/tcltk2-package.Rd
===================================================================
--- pkg/tcltk2/man/tcltk2-package.Rd 2013-12-05 14:59:07 UTC (rev 540)
+++ pkg/tcltk2/man/tcltk2-package.Rd 2013-12-11 16:03:40 UTC (rev 541)
@@ -16,8 +16,8 @@
\tabular{ll}{
Package: \tab tcltk2\cr
Type: \tab Package\cr
-Version: \tab 1.2-7\cr
-Date: \tab 2013-11-30\cr
+Version: \tab 1.2-9\cr
+Date: \tab 2013-12-11\cr
License: \tab LGPL-3 plus see LICENSE file\cr
LazyLoad: \tab yes\cr
}
More information about the Sciviews-commits
mailing list