[Sciviews-commits] r313 - in pkg/tcltk2: . R man man/unix man/windows win/src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Sep 25 10:00:38 CEST 2010
Author: phgrosjean
Date: 2010-09-25 10:00:38 +0200 (Sat, 25 Sep 2010)
New Revision: 313
Modified:
pkg/tcltk2/DESCRIPTION
pkg/tcltk2/LICENSE
pkg/tcltk2/NAMESPACE
pkg/tcltk2/NEWS
pkg/tcltk2/R/tclTask.R
pkg/tcltk2/R/tclVarFun.R
pkg/tcltk2/R/tcltk2-Internal.R
pkg/tcltk2/R/tk2commands.R
pkg/tcltk2/R/tk2dde.R
pkg/tcltk2/R/tk2dialogs.R
pkg/tcltk2/R/tk2edit.R
pkg/tcltk2/R/tk2fonts.R
pkg/tcltk2/R/tk2ico.R
pkg/tcltk2/R/tk2reg.R
pkg/tcltk2/R/tk2tip.R
pkg/tcltk2/R/tk2widgets.R
pkg/tcltk2/man/setLanguage.Rd
pkg/tcltk2/man/tclTask.Rd
pkg/tcltk2/man/tclVarFun.Rd
pkg/tcltk2/man/tcltk2-package.Rd
pkg/tcltk2/man/tk2commands.Rd
pkg/tcltk2/man/tk2dialogs.Rd
pkg/tcltk2/man/tk2edit.Rd
pkg/tcltk2/man/tk2fonts.Rd
pkg/tcltk2/man/tk2tip.Rd
pkg/tcltk2/man/tk2widgets.Rd
pkg/tcltk2/man/unix/tk2dde.Rd
pkg/tcltk2/man/unix/tk2ico.Rd
pkg/tcltk2/man/unix/tk2reg.Rd
pkg/tcltk2/man/windows/tk2dde.Rd
pkg/tcltk2/man/windows/tk2ico.Rd
pkg/tcltk2/man/windows/tk2reg.Rd
pkg/tcltk2/test.R
pkg/tcltk2/win/src/Winico06.c
Log:
Reworking of R ocde and man page (style)
Modified: pkg/tcltk2/DESCRIPTION
===================================================================
--- pkg/tcltk2/DESCRIPTION 2010-09-25 07:49:15 UTC (rev 312)
+++ pkg/tcltk2/DESCRIPTION 2010-09-25 08:00:38 UTC (rev 313)
@@ -7,8 +7,8 @@
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
-Version: 1.1-4
-Date: 2010-09-31
+Version: 1.1-5
+Date: 2010-09-24
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: file LICENSE
Modified: pkg/tcltk2/LICENSE
===================================================================
--- pkg/tcltk2/LICENSE 2010-09-25 07:49:15 UTC (rev 312)
+++ pkg/tcltk2/LICENSE 2010-09-25 08:00:38 UTC (rev 313)
@@ -954,4 +954,4 @@
damages, loss of profits, loss of use, loss of goodwill, computer failure
or malfunction. Licensee agrees to indemnify and hold harmless licensor
for any and all liability licensor may incur as a result of licensee's use
- of the software.
\ No newline at end of file
+ of the software.
Modified: pkg/tcltk2/NAMESPACE
===================================================================
--- pkg/tcltk2/NAMESPACE 2010-09-25 07:49:15 UTC (rev 312)
+++ pkg/tcltk2/NAMESPACE 2010-09-25 08:00:38 UTC (rev 313)
@@ -1,17 +1,17 @@
import(tcltk)
export(makeTclNames,
- tclAfter,
- tclAfterCancel,
- tclAfterInfo,
- tclFun,
+ tclAfter,
+ tclAfterCancel,
+ tclAfterInfo,
+ tclFun,
tclGetValue,
tclSetValue,
- tclTaskChange,
- tclTaskDelete,
- tclTaskGet,
- tclTaskRun,
- tclTaskSchedule,
+ tclTaskChange,
+ tclTaskDelete,
+ tclTaskGet,
+ tclTaskRun,
+ tclTaskSchedule,
tclVarExists,
tclVarFind,
tclVarName,
@@ -54,8 +54,8 @@
tk2notetab.select,
tk2notetab.text,
tk2state.set,
- is.tk,
- is.ttk,
+ is.tk,
+ is.ttk,
tk2theme.elements,
tk2theme.list,
tk2theme,
@@ -93,4 +93,4 @@
getLanguage,
setLanguage)
-S3method(print, tclTask)
\ No newline at end of file
+S3method(print, tclTask)
Modified: pkg/tcltk2/NEWS
===================================================================
--- pkg/tcltk2/NEWS 2010-09-25 07:49:15 UTC (rev 312)
+++ pkg/tcltk2/NEWS 2010-09-25 08:00:38 UTC (rev 313)
@@ -1,5 +1,11 @@
= tcltk2 news
+== Version 1.1-5
+
+* Little correction in Winico.c that prevented it to compile correctly on all
+ Windows architectures (thanks Prof. B. Ripley for the patch).
+
+
== Version 1.1-4
* Winico.c modified to compile on Windows 64-bit (but still not OK?).
Modified: pkg/tcltk2/R/tclTask.R
===================================================================
--- pkg/tcltk2/R/tclTask.R 2010-09-25 07:49:15 UTC (rev 312)
+++ pkg/tcltk2/R/tclTask.R 2010-09-25 08:00:38 UTC (rev 313)
@@ -1,38 +1,35 @@
-# tclTask.R - Functions to schedule task to be executed later using Tcl after
-# Copyright (c), Philippe Grosjean (phgrosjean at sciviews.org)
-# Licensed under LGPL 3 or above
-#
-# Changes:
-# - 2009-07-02: fisrt version (for tcltk2_1.1-0)
+### tclTask.R - Functions to schedule task to be executed later using Tcl after
+### Copyright (c), Philippe Grosjean (phgrosjean at sciviews.org)
+### Licensed under LGPL 3 or above
+###
+### Changes:
+### - 2009-07-02: fisrt version (for tcltk2_1.1-0)
-"tclAfter" <-
-function (wait, fun)
+tclAfter <- function (wait, fun)
{
- # This is the basic Tcl command, do prefer tclTaskSchedule()!
+ ## This is the basic Tcl command, do prefer tclTaskSchedule()!
wait <- as.integer(wait)[1]
- if (wait <= 0) wait <- "idle" # Schedule task on next event loop
- # Check fun
+ if (wait <= 0) wait <- "idle" # Schedule task on next event loop
+ ## Check fun
if (!is.function(fun))
stop("'fun' must be a function")
- # Install a new Tcl timer
+ ## Install a new Tcl timer
tcl("after", wait, fun)
}
-"tclAfterCancel" <-
-function (task)
+tclAfterCancel <- function (task)
{
- # Cancel a Tcl timer (no effect if the timer does not exist)
+ ## Cancel a Tcl timer (no effect if the timer does not exist)
tcl("after", "cancel", as.character(task)[1])
}
-"tclAfterInfo" <-
-function (task = NULL)
+tclAfterInfo <- function (task = NULL)
{
- # Get info about a Tcl timer, or list all current ones (using task = NULL)
+ ## Get info about a Tcl timer, or list all current ones (using task = NULL)
if (is.null(task)) {
return(tcl("after", "info"))
} else {
- # First check that task exists
+ ## First check that task exists
task <- as.character(task)[1]
ok <- tclvalue(.Tcl(paste("catch {after info ", task, "}", sep = "")))
if (ok == 0) {
@@ -41,15 +38,14 @@
}
}
-"print.tclTask" <-
-function (x, ...)
+print.tclTask <- function (x, ...)
{
- # Look when the task is run
+ ## Look when the task is run
if (x$wait == "idle") {
cat("tclTask '", x$id, "' scheduled on next event loop\n", sep = "")
} else {
cat("tclTask '", x$id, "' scheduled after ", x$wait, " ms ", sep = "")
- # Determine how much is remaining
+ ## Determine how much is remaining
rem <- x$started + x$wait - proc.time()["elapsed"] * 1000
if (rem <= 0) {
cat("(elapsed)\n")
@@ -57,7 +53,7 @@
cat("(", as.integer(rem), " remaining)\n", sep = "")
}
}
- # Look if it is rescheduled
+ ## Look if it is rescheduled
if (isTRUE(x$redo)) {
cat("Rescheduled forever\n")
} else if (x$redo == FALSE || x$redo <= 0) {
@@ -67,30 +63,29 @@
} else {
cat("Rescheduled", x$redo, "times\n")
}
- # Print the command to be executed
+ ## Print the command to be executed
cat("runs:\n")
print(x$expr)
return(invisible(x))
}
-"tclTaskSchedule" <-
-function (wait, expr, id = "task#", redo = FALSE)
+tclTaskSchedule <- function (wait, expr, id = "task#", redo = FALSE)
{
- # Schedule a task to be executed after 'wait' ms
- # If 'wait' is <= 0, schedule for execution on the next event loop
- # Id is the task name to use (if the task already exists, it is deleted
- # and replaced by the new definition)
+ ## Schedule a task to be executed after 'wait' ms
+ ## If 'wait' is <= 0, schedule for execution on the next event loop
+ ## Id is the task name to use (if the task already exists, it is deleted
+ ## and replaced by the new definition)
wait <- as.integer(wait)[1]
- if (wait <= 0) wait <- "idle" # Schedule task on next event loop
+ if (wait <= 0) wait <- "idle" # Schedule task on next event loop
Tasks <- .getTclTasks()
TNames <- ls(Tasks, all = TRUE)
id <- as.character(id)[1]
- # If 'id' contains '#', replace it by a number (first one available)
- # but don't allow more than 1000 tasks with same name (to avoid bad
- # situations with buggy code like infinite loops or so)
+ ## If 'id' contains '#', replace it by a number (first one available)
+ ## but don't allow more than 1000 tasks with same name (to avoid bad
+ ## situations with buggy code like infinite loops or so)
if (grepl("#", id)) {
for (i in 1:1000) {
Id <- sub("#", i, id)
@@ -99,7 +94,7 @@
if (Id %in% TNames)
stop("Too many tclTasks!")
} else {
- # Delete the task if it already exists
+ ## Delete the task if it already exists
if (id %in% TNames) tclTaskDelete(id)
Id <- id
}
@@ -109,28 +104,27 @@
if (redo <= 0) redo <- FALSE
}
- # Schedule the task, but don't run expr directly, but through tclTaskRun()
- # Note: if I use tcl("after", wait, tclTaskRun(Id), R is blocked until the
- # task is done. Here, I must provide the name of a function without args)
+ ## Schedule the task, but don't run expr directly, but through tclTaskRun()
+ ## Note: if I use tcl("after", wait, tclTaskRun(Id), R is blocked until the
+ ## task is done. Here, I must provide the name of a function without args)
task <- .makeTclTask(id = Id, wait = wait)
- # Create a tclTask object containing all info about this task
+ ## Create a tclTask object containing all info about this task
res <- list(task = task, id = Id, expr = substitute(expr),
started = proc.time()["elapsed"] * 1000, wait = wait,
redo = redo)
class(res) <- c("tclTask", class(res))
- # Add this task to the list
+ ## Add this task to the list
Tasks[[Id]] <- res
return(invisible(res))
}
-"tclTaskRun" <-
-function(id)
+tclTaskRun <- function(id)
{
- # Execute the code associated with a given task and detemine if the task
- # should be rescheduled again (repeat argument)
+ ## Execute the code associated with a given task and detemine if the task
+ ## should be rescheduled again (repeat argument)
id <- as.character(id)[1]
Tasks <- .getTclTasks()
@@ -139,53 +133,51 @@
warning("tclTask '", id, "' is not found")
return(invisible(FALSE))
}
- # Make sure to indicate that we run it once
+ ## Make sure to indicate that we run it once
if (!is.logical(Task$redo)) {
Task$redo <- Task$redo - 1
if (Task$redo < 1) Task$redo <- FALSE
}
- # Update the original object too
+ ## Update the original object too
Tasks[[id]] <- Task
- # Run the code associate with this task
+ ## Run the code associate with this task
eval(Task$expr, envir = .GlobalEnv)
- # Should we delete this task (if repeat is FALSE), or reschedule it?
- # Note, we read Task again, in case fun() would have changed something there!
+ ## Should we delete this task (if repeat is FALSE), or reschedule it?
+ ## Note, we read Task again, in case fun() would have changed something there!
Task <- Tasks[[id]]
- # Make sure the tcl timer is destroyed (in case tclTaskRun() is
- # triggered otherwise)
+ ## Make sure the tcl timer is destroyed (in case tclTaskRun() is
+ ## triggered otherwise)
tclTaskDelete(id)
if (Task$redo) {
- # Reschedule the task
+ ## Reschedule the task
Task$task <- .makeTclTask(id = id, wait = Task$wait)
- # and update information in .tclTasks
+ ## and update information in .tclTasks
Tasks[[id]] <- Task
}
return(invisible(TRUE))
}
-"tclTaskGet" <-
-function(id = NULL, all = FALSE)
+tclTaskGet <- function(id = NULL, all = FALSE)
{
- # If id is NULL, list all scheduled tasks, otherwise, give info about a
- # particular scheduled task
+ ## If id is NULL, list all scheduled tasks, otherwise, give info about a
+ ## particular scheduled task
if (is.null(id)) {
return(ls(.getTclTasks(), all = all))
} else {
- # Get the data associated with a scheduled task
+ ## Get the data associated with a scheduled task
return(.getTclTasks()[[id]])
}
}
-"tclTaskChange" <-
-function (id, expr, wait, redo)
+tclTaskChange <- function (id, expr, wait, redo)
{
- # Change a characteristic of a scheduled task
- # Is there something to change?
+ ## Change a characteristic of a scheduled task
+ ## Is there something to change?
if (missing(expr) && missing(wait) && missing(redo))
return(invisible(FALSE))
- # Get task and change it
+ ## Get task and change it
Tasks <- .getTclTasks()
Task <- Tasks[[id]]
if (is.null(Task)) {
@@ -195,7 +187,7 @@
if (!missing(expr)) Task$expr <- substitute(expr)
if (!missing(wait )) {
wait <- as.integer(wait)[1]
- if (wait <= 0) wait <- "idle" # Schedule task on next event loop
+ if (wait <= 0) wait <- "idle" # Schedule task on next event loop
Task$wait <- wait
}
if (!missing(redo)) {
@@ -205,41 +197,39 @@
}
Task$redo <- redo
}
- # Delete the task and recreate it with the new parameters
+ ## Delete the task and recreate it with the new parameters
tclTaskDelete(id)
Task$task <- .makeTclTask(id = id, wait = Task$wait)
- # Update Tasks
+ ## Update Tasks
Tasks[[id]] <- Task
return(invisible(TRUE))
}
-"tclTaskDelete" <-
-function (id)
+tclTaskDelete <- function (id)
{
Tasks <- .getTclTasks()
- # Remove a previously scheduled task (if id s NULL, then, remove all tasks)
+ ## Remove a previously scheduled task (if id s NULL, then, remove all tasks)
if (is.null(id)) {
- # Delete all current tasks
+ ## Delete all current tasks
for (Task in ls(Tasks, all = TRUE))
tclAfterCancel(Tasks[[Task]]$task)
- # Eliminate .tclTasks environment from TempEnv
+ ## Eliminate .tclTasks environment from TempEnv
rm(list = ".tclTasks", envir = .TempEnv())
} else {
- # Delete only one task
+ ## Delete only one task
Task <- Tasks[[id]]
- if (!is.null(Task)) { # The task exists
+ if (!is.null(Task)) { # The task exists
tclAfterCancel(Task$task)
rm(list = id, envir = Tasks)
}
}
}
-".getTclTasks" <-
-function ()
+.getTclTasks <- function ()
{
- # Retrieve references to all scheduled tasks
+ ## Retrieve references to all scheduled tasks
res <- .getTemp(".tclTasks", default = NULL)
if (is.null(res)) {
res <- new.env(parent = .TempEnv())
@@ -248,8 +238,7 @@
return(res)
}
-".makeTclTask" <-
-function (id, wait)
+.makeTclTask <- function (id, wait)
{
run <- function ()
eval(parse(text = paste('tclTaskRun("', id, '")', sep = "")))
Modified: pkg/tcltk2/R/tclVarFun.R
===================================================================
--- pkg/tcltk2/R/tclVarFun.R 2010-09-25 07:49:15 UTC (rev 312)
+++ pkg/tcltk2/R/tclVarFun.R 2010-09-25 08:00:38 UTC (rev 313)
@@ -1,132 +1,131 @@
-# tclVarFun.R - A series of additional function to manipulate Tcl variables
-# and functions from within R and vice versa
-# Copyright (c), Philippe Grosjean (phgrosjean at sciviews.org)
-# Licensed under LGPL 3 or above
-#
-# Changes:
-# - 2007-01-01: fisrt version (for tcltk2_1.0-0)
-#
-# To do:
-# - Add a catch {} in tclFun and handle it
-# - A tclFunDispose() function to delete the Tcl equivalent of a function
-# - Add a try construct in tclVarExists and tclVarFind
-# - better manage catch{} in tclVarName
+### tclVarFun.R - A series of additional function to manipulate Tcl variables
+### and functions from within R and vice versa
+### Copyright (c), Philippe Grosjean (phgrosjean at sciviews.org)
+### Licensed under LGPL 3 or above
+###
+### Changes:
+### - 2007-01-01: fisrt version (for tcltk2_1.0-0)
+###
+### To do:
+### - Add a catch {} in tclFun and handle it
+### - A tclFunDispose() function to delete the Tcl equivalent of a function
+### - Add a try construct in tclVarExists and tclVarFind
+### - better manage catch{} in tclVarName
-"makeTclNames" <-
-function(names, unique = FALSE) {
- # Make valid Tcl variable names (allow_ = TRUE by default in R >= 2.0.0)
+makeTclNames <- function (names, unique = FALSE)
+{
+ ## Make valid Tcl variable names (allow_ = TRUE by default in R >= 2.0.0)
names <- make.names(names, unique = unique)
- # There is a problem if the variable starts with a dot => prepend it with 'X'
+ ## There is a problem if the variable starts with a dot => prepend it with 'X'
.names <- grep("^\\.", names)
names[.names] <- paste("X", names[.names], sep = "")
- # Although it is accepted, there could be problems with variable names
- # containing dots, so, replace them with '_'
+ ## Although it is accepted, there could be problems with variable names
+ ## containing dots, so, replace them with '_'
names <- gsub("\\.", "_", names)
return(names)
}
### TODO: change this to use closure functions instead!!!
-"tclFun" <-
-function(f, name = deparse(substitute(f))) {
- # Register a simple R function (without arguments) as a callback in Tcl,
- # and give it the same name under Tcl)
- # Indeed, .Tcl.callback(f) does the job... but it gives criptic names
- # like R_call 0x13c7168
- # Done in NAMESPACE
- #Require(tcltk) || stop("Package 'tcltk' is needed!")
+tclFun <- function (f, name = deparse(substitute(f)))
+{
+ ## Register a simple R function (without arguments) as a callback in Tcl,
+ ## and give it the same name under Tcl)
+ ## Indeed, .Tcl.callback(f) does the job... but it gives criptic names
+ ## like R_call 0x13c7168
- # Check that 'f' is a function with no arguments (cannot handle them yet)
+ ## Check that 'f' is a function with no arguments (cannot handle them yet)
if (!is.function(f)) stop("'f' must be a function!")
if (!is.null(formals(f))) stop("The function used cannot (yet) have arguments!")
- # Make sure the name of the function is valid
+ ## Make sure the name of the function is valid
if (!is.character(name)) stop("'name' must be a character string!") else
name <- make.names(name[1])
res <- .Tcl.callback(f)
- # Make sure this is correct (R_call XXXXXXXX)
+ ## Make sure this is correct (R_call XXXXXXXX)
if (length(grep("R_call ", res) > 0)) {
- # Create a proc with the same name in Tcl
+ ## Create a proc with the same name in Tcl
.Tcl(paste("proc ", name, " {} {", res, "}", sep = ""))
}
- # Return the R_call XXXXXXXX string, as .Tcl.callback() does
+ ## Return the R_call XXXXXXXX string, as .Tcl.callback() does
return(res)
- # Rem: if you delete the R 'f' function, the Tcl 'f' function still works!
- # You have to explicitly delete the Tcl function
+ ## Rem: if you delete the R 'f' function, the Tcl 'f' function still works!
+ ## You have to explicitly delete the Tcl function
}
-"tclGetValue" <- function(name) {
- # Get the value stored in a plain Tcl variable
+tclGetValue <- function (name)
+{
+ ## Get the value stored in a plain Tcl variable
if (!is.character(name))
stop("'name' must be a character!")
name <- makeTclNames(name[1]) # The usual name conversion
- # Create a temporary dual variable with tclVar() (name does not mather)
+ ## Create a temporary dual variable with tclVar() (name does not mather)
Temp <- tclVar(init = "")
- # Copy the content of the var of interest to it
+ ## Copy the content of the var of interest to it
res <- tclvalue(.Tcl(paste("catch {set ", as.character(Temp), " $", name,
- "}", sep = ""))) # Return "0" if OK, "1" otherwise
+ "}", sep = ""))) # Return "0" if OK, "1" otherwise
if (res != "0")
stop(gettextf("Error when getting the value in the '%s' Tcl variable",
name))
- # Get the content of the temporary variable
+ ## Get the content of the temporary variable
return(tclvalue(Temp)) # (Temp will be destroyed when the function exits)
}
-"tclSetValue" <- function(name, value) {
- # This is the opposite of tclGetValue() and it is a wrapper
- # for 'set name value' Tcl command
+tclSetValue <- function (name, value)
+{
+ ## This is the opposite of tclGetValue() and it is a wrapper
+ ## for 'set name value' Tcl command
if (!is.character(name))
stop("'name' must be a character!")
name <- makeTclNames(name[1]) # The usual name conversion
- # Create a temporary dual variable with tclVar() (name does not mather)
+ ## Create a temporary dual variable with tclVar() (name does not mather)
Temp <- tclVar(init = value)
- # Copy the content of this variable to the tcl variable 'name'
+ ## Copy the content of this variable to the tcl variable 'name'
res <- tclvalue(.Tcl(paste("catch {set ", name, " $", as.character(Temp),
"}", sep = "")))
if (res != "0")
stop(gettextf("Error when changing the value of the '%s' Tcl variable",
name))
- # (Temp is destroyed when the function exits)
- return(invisible(name)) # Return the name of the Tcl variable invisibly
+ ## (Temp is destroyed when the function exits)
+ return(invisible(name)) # Return the name of the Tcl variable invisibly
}
-"tclVarExists" <- function(name) {
+tclVarExists <- function (name)
as.integer(tcl("info", "exists", name)) == 1
-}
-"tclVarFind" <- function(pattern) {
+tclVarFind <- function (pattern)
as.character(tcl("info", "vars", pattern))
-}
-"tclVarName" <- function(name, init = "", keep.existing = TRUE) {
- # tclVar gives names like ::RtclX automatically...
- # We need to define names ourselve. This is what tclVarName does
- # If keep existing == TRUE and the variable is already defined, then
- # we keep its content, instead of initializing it with "init"
+tclVarName <- function (name, init = "", keep.existing = TRUE)
+{
+ ## tclVar gives names like ::RtclX automatically...
+ ## We need to define names ourselve. This is what tclVarName does
+ ## If keep existing == TRUE and the variable is already defined, then
+ ## we keep its content, instead of initializing it with "init"
if (!is.character(name)) stop("'name' must be a character!")
- name <- makeTclNames(name[1]) # Make sure the name is correct
+ name <- makeTclNames(name[1]) # Make sure the name is correct
- # Temporary save potential content of the Tcl variable elsewhere
- # (catch in case the variable does not exist)
- if (keep.existing[1] == TRUE)
+ ## Temporary save potential content of the Tcl variable elsewhere
+ ## (catch in case the variable does not exist)
+ if (isTRUE(keep.existing))
.Tcl(paste("catch {set ZZZTempRvariable $", name, "}", sep = ""))
- # Create the new dual Tcl-R variable
+ ## Create the new dual Tcl-R variable
l <- list(env = new.env())
assign(name, NULL, envir = l$env)
reg.finalizer(l$env, function(env) tcl("unset", ls(env)))
class(l) <- "tclVar"
tclvalue(l) <- init
- # Possibly restore the content of the variable, if keep.existing == TRUE
- if (keep.existing) {
+ ## Possibly restore the content of the variable, if keep.existing == TRUE
+ if (isTRUE(keep.existing)) {
.Tcl(paste("catch {set", name, "$ZZZTempRvariable}"))
- # Remove the temporary variable
+ ## Remove the temporary variable
.Tcl("unset -nocomplain ZZZTempRvariable")
}
return(l)
Modified: pkg/tcltk2/R/tcltk2-Internal.R
===================================================================
--- pkg/tcltk2/R/tcltk2-Internal.R 2010-09-25 07:49:15 UTC (rev 312)
+++ pkg/tcltk2/R/tcltk2-Internal.R 2010-09-25 08:00:38 UTC (rev 313)
@@ -1,15 +1,14 @@
-# tcltk2-Internal.R - Hidden functions for tcltk2
-# Copyright (c), Philippe Grosjean (phgrosjean at sciviews.org)
-#
-# TODO:
-# - Rework the tile stuff
-# - .onUnload() function (unload DLLs etc. but there are no DLLs any more!?)
+### tcltk2-Internal.R - Hidden functions for tcltk2
+### Copyright (c), Philippe Grosjean (phgrosjean at sciviews.org)
+###
+### TODO:
+### - Rework the tile stuff
+### - .onUnload() function (unload DLLs etc. but there are no DLLs any more!?)
-".onLoad" <-
-function(libname, pkgname) {
+.onLoad <- function(libname, pkgname) {
libdir <- file.path(libname, pkgname, "tklibs")
- # A slightly modified version of addTclPath() that works also within SciViews
+ ## A slightly modified version of addTclPath() that works also within SciViews
addTclPath <- function (path = ".") {
if (.Platform$OS.type == "windows")
path <- gsub("\\\\", "/", path)
@@ -19,52 +18,52 @@
tcl("lappend", "::auto_path", path)
}
res <- addTclPath(libdir) # extend the Tcl/Tk path
- ### TODO: add path to bin!
- ### TODO: get windowing system with .Tcl("tk windowingsystem")
- #Yes, .Platform$OS == "unix" in Mac. However, perhaps you're not
- #interested in the OS type, though, but you're interested in the type
- #of GUI. .Platform$GUI which is "AQUA" if you run R in the usual
- #graphical UI window, but "X11" if you run R in X11 terminal or bash
- #terminal window (and these really are different beasts GUI-wise).
- #Further, .Platform$pkgType == "mac.binary" in CRAN releases of Mac R
- #(but may be different if users have built R from the source).
- #Function install.packages() uses .Platform$pkgType to detect the platform.
+### TODO: add path to bin!
+### TODO: get windowing system with .Tcl("tk windowingsystem")
+ ## Yes, .Platform$OS == "unix" in Mac. However, perhaps you're not
+ ## interested in the OS type, though, but you're interested in the type
+ ## of GUI. .Platform$GUI which is "AQUA" if you run R in the usual
+ ## graphical UI window, but "X11" if you run R in X11 terminal or bash
+ ## terminal window (and these really are different beasts GUI-wise).
+ ## Further, .Platform$pkgType == "mac.binary" in CRAN releases of Mac R
+ ## (but may be different if users have built R from the source).
+ ## Function install.packages() uses .Platform$pkgType to detect the platform.
- # Make sure that Tcl/Tk locale is the same one as current R locale
+ ## 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
+ if (lang != "") { # Set the same language for Tcl/Tk
res <- tclRequire("msgcat")
if (inherits(res, "tclObj")) tcl("::msgcat::mclocale", lang)
}
if (is.tk()) {
- # Here is how we could install the supplementary material in Tcl
- #tclRequire("combobox") # Version 2.3
- #tclRequire("choosefont") # Version 0.2
- #tclRequire("ctext") # Version 3.1
- #tclRequire("cursor") # Version 0.1
- #tclRequire("mclistbox") # Version 1.2
- #Not provided any more -> tclRequire("Tktable") # Version 2.9
+ ## Here is how we could install the supplementary material in Tcl
+ ##tclRequire("combobox") # Version 2.3
+ ##tclRequire("choosefont") # Version 0.2
+ ##tclRequire("ctext") # Version 3.1
+ ##tclRequire("cursor") # Version 0.1
+ ##tclRequire("mclistbox") # Version 1.2
+ ##Not provided any more -> tclRequire("Tktable") # Version 2.9
- # The following code is not implemented as Tcl package... just source it
+ ## The following code is not implemented as Tcl package... just source it
tcl("source", file.path(libdir, "notebook1.3", "notebook.tcl"))
tcl("source", file.path(libdir, "tree1.7", "tree.tcl"))
- # Do we try to load the tile widgets? (only if Tcl./Tk < 8.5)
+ ## Do we try to load the tile widgets? (only if Tcl./Tk < 8.5)
if (as.numeric(.Tcl("set ::tcl_version")) < 8.5) {
-# tcl("source", file.path(libdir, "fonts.tcl"))
- # Define fonts used in Tk (note: must be done AFTER loading tile!)
+### 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...
## but they should be computer from the system, actually
## We collect back those values calculated by tile and possibly override
## them with better values
-# tk2font.setstyle(system = TRUE, default.styles = TRUE, text = TRUE)
+### tk2font.setstyle(system = TRUE, default.styles = TRUE, text = TRUE)
### TODO: reflect possible changes to other graphical toolkits (how?)
### TODO: homogenize R console, R graph, SciTe fonts with these fonts
} else { # There is a bug in mclistbox with Tcl/Tk 8.5
- # Patch by Christiane Raemsch, slightly modified by Ph. Grosjean
- # This is essentially the listbox procedure, but with an additional
- # focus argument required by mclistbox
+ ## Patch by Christiane Raemsch, slightly modified by Ph. Grosjean
+ ## This is essentially the listbox procedure, but with an additional
+ ## focus argument required by mclistbox
.Tcl('proc ::tk::ListboxBeginSelect {w el {focus 0}} {
variable ::tk::Priv
if {[$w cget -selectmode] eq "multiple"} {
@@ -87,44 +86,42 @@
}')
}
}
- # Try loading addtional ttk themes
+ ## Try loading addtional ttk themes
try(tclRequire("ttk::theme::plastik"), silent = TRUE)
try(tclRequire("ttk::theme::keramik"), silent = TRUE)
try(tclRequire("ttk::theme::keramik_alt"), silent = TRUE)
- # Windows only
+ ## Windows only
if (.Platform$OS.type == "windows") {
tclRequire("dde") # Version 1.2.2
- # Not loaded automatically!
+ ## Not loaded automatically!
#tclRequire("registry") # Version 1.1.3
if (nzchar(r_arch <- .Platform$r_arch))
tcl("load", file.path(libname, pkgname, "libs", r_arch, "Winico06.dll"))
else
tcl("load", file.path(libname, pkgname, "libs", "Winico06.dll"))
- # Also register the DDE server as TclEval|R
+ ## Also register the DDE server as TclEval|R
tk2dde("R")
} else {
- # Use plastik theme by default
+ ## Use plastik theme by default
try(tk2theme("plastik"), silent = TRUE)
}
}
-### TO DO: .onUnload() that close downloaded tk items (or unload Tcl completely?)
-# Use package forget and change auto_path, ... or leave like this to avoid
-# breaking Tcl?
+### TODO: .onUnload() that close downloaded tk items (or unload Tcl completely?)
+### Use package forget and change auto_path, ... or leave like this to avoid
+### breaking Tcl?
-".Last.lib" <-
-function (libpath)
+.Last.lib <- function (libpath)
{
- # Remove all currently scheduled tasks
+ ## Remove all currently scheduled tasks
tclTaskDelete(id = NULL)
}
-".TempEnv" <-
-function ()
+.TempEnv <- function ()
{
pos <- match("TempEnv", search())
- if (is.na(pos)) { # Must create it
+ if (is.na(pos)) { # Must create it
TempEnv <- list()
attach(TempEnv, pos = length(search()) - 1)
rm(TempEnv)
@@ -133,14 +130,12 @@
return(pos.to.env(pos))
}
-".assignTemp" <-
-function (x, value, replace.existing = TRUE)
+.assignTemp <- function (x, value, replace.existing = TRUE)
if (replace.existing || !exists(x, envir = .TempEnv(), mode = "any",
inherits = FALSE))
assign(x, value, envir = .TempEnv())
-".getTemp" <-
-function (x, default = NULL, mode = "any", item = NULL)
+.getTemp <- function (x, default = NULL, mode = "any", item = NULL)
{
if (is.null(item)) Mode <- mode else Mode <- "any"
if (exists(x, envir = .TempEnv(), mode = Mode, inherits = FALSE)) {
@@ -155,7 +150,7 @@
return(default)
}
}
- } else { # Variable not found, return the default value
+ } else { # Variable not found, return the default value
return(default)
}
}
Modified: pkg/tcltk2/R/tk2commands.R
===================================================================
--- pkg/tcltk2/R/tk2commands.R 2010-09-25 07:49:15 UTC (rev 312)
+++ pkg/tcltk2/R/tk2commands.R 2010-09-25 08:00:38 UTC (rev 313)
@@ -1,85 +1,86 @@
-# tk2commands.R - Additional tk commands to manipulate tk2 widgets
-# Copyright (c), Philippe Grosjean (phgrosjean at sciviews.org)
-# Licensed under LGPL 3 or above
-#
-# Changes:
-# - 2007-01-01: fisrt version (for tcltk2_1.0-0)
-#
-# To do:
-# - Rework all this...
-# - Style option of Tile widgets?
-# - Implement style element options ...
+### tk2commands.R - Additional tk commands to manipulate tk2 widgets
+### Copyright (c), Philippe Grosjean (phgrosjean at sciviews.org)
+### Licensed under LGPL 3 or above
+###
+### Changes:
+### - 2007-01-01: fisrt version (for tcltk2_1.0-0)
+###
+### To do:
+### - Rework all this...
+### - Style option of Tile widgets?
+### - Implement style element options ...
-"tk2column" <-
-function(widget, action = c("add", "configure", "delete", "names", "cget", "nearest"), ...) {
+tk2column <- function (widget, action = c("add", "configure", "delete", "names",
+"cget", "nearest"), ...)
+{
Action <- action[1]
tcl(widget, "column", Action, ...)
}
-"tk2list.set" <-
-function(widget, items) {
- # Set a list of values for a widget (e.g., combobox)
+tk2list.set <- function (widget, items)
+{
+ ## Set a list of values for a widget (e.g., combobox)
if (inherits(widget, "ttk2combobox")) {
- # ttk::combobox uses -values parameter
+ ## ttk::combobox uses -values parameter
tkconfigure(widget, values = as.character(items))
} else {
- # Try to use the defaul method
- # First, clear the list
+ ## Try to use the defaul method
+ ## First, clear the list
tcl(widget, "list", "delete", 0, "end")
- # Then, insert all its elements
+ ## Then, insert all its elements
items <- as.character(items)
for (item in items) tcl(widget, "list", "insert", "end", item)
}
}
-"tk2list.insert" <-
-function(widget, index = "end", ...) {
- # Insert one or more items in a list
+tk2list.insert <- function (widget, index = "end", ...)
+{
+ ## Insert one or more items in a list
if (inherits(widget, "ttk2combobox")) {
- # ttk::combobox uses -values parameter
+ ## ttk::combobox uses -values parameter
Items <- as.character(unlist(list(...)))
if (length(Items) < 1) return() # Nothing to insert
List <- as.character(tcl(widget, "cget", "-values"))
if (length(List) < 2 && List == "") {
- # The list in empty, simply add these items
+ ## The list in empty, simply add these items
List <- Items
} else if (index == "end" || index > length(List) - 1) {
List <- c(List, Items)
} else if (index == 0){
- # Insert items at the beginning of the list
+ ## Insert items at the beginning of the list
List <- c(Items, List)
} else {
- # Insert items inside the list
+ ## Insert items inside the list
List <- c(List[1:index], Items, List[(index + 1):length(List)])
}
- # Reassign this modified list to the combobox
+ ## Reassign this modified list to the combobox
tkconfigure(widget, values = List)
} else {
tcl(widget, "list", "insert", index, ...)
}
}
-"tk2list.delete" <-
-function(widget, first, last = first) {
- # Delete one or more items from a list
+tk2list.delete <- function (widget, first, last = first)
+{
+ ## Delete one or more items from a list
if (inherits(widget, "ttk2combobox")) {
- # ttk::combobox uses -values parameter
+ ## ttk::combobox uses -values parameter
List <- as.character(tcl(widget, "cget", "-values"))
if (length(List) < 2 && List == "") return(List) # The list in empty
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/sciviews -r 313
More information about the Sciviews-commits
mailing list