[Rd] using yscrollcommand in tkcanvas crashes R (PR#13231)

[Paul Roebuck]

On Thu, 30 Oct 2008 sundar.dorai-raj at pdf.com wrote:

> Full_Name: Sundar Dorai-Raj
> Version: 2.8.0
> OS: Windows
> Submission from: (NULL) (76.220.41.126)
>
>
> The following code crashes R:
>
> library(tcltk)
> tt <- tktoplevel()
> tc <- tkcanvas(tt, yscrollcommand = function(...) tkset(ts, ...))
>
> > sessionInfo()
> R version 2.8.0 (2008-10-20)
> i386-pc-mingw32
>
> locale:
> LC_COLLATE=English_United States.1252;LC_CTYPE=English_United
> States.1252;LC_MONETARY=English_United
> States.1252;LC_NUMERIC=C;LC_TIME=English_United States.1252
>
> attached base packages:
> [1] tcltk     stats     graphics  grDevices utils     datasets  methods
> [8] base
>

Here's a portion of the code I wrote for a package that
contains a scrollable canvas, if it helps you any.


.RDEnv <- new.env(hash=TRUE)                   # Private environment

rdenv <- function() {
    return(.RDEnv)
}


scrollframe_create <- function(parent) {
    stopifnot(is.tkwin(parent))

    frame <- tkframe(parent,
                     class="ScrollFrame")
    xscroll <- tkscrollbar(frame,
                           orient="horizontal",
                           command=function(...) tkxview(vport, ...))
    yscroll <- tkscrollbar(frame,
                           orient="vertical",
                           command=function(...) tkyview(vport, ...))
    vport <- tkcanvas(frame,
                      xscrollcommand=function(...) tkset(xscroll, ...),
                      yscrollcommand=function(...) tkset(yscroll, ...))

    pady <- paste("0", tclvalue(tkwinfo.reqheight(xscroll)))
    tkpack(yscroll, side="right", fill="y", pady=pady)
    tkpack(xscroll, side="bottom", fill="x")
    tkpack(vport, side="left", fill="both", expand=TRUE)

    int.frame <- tkframe(vport,
                         borderwidth=4,
                         relief="groove")
    tkcreate(vport, "window", "0 0", anchor="nw", window=int.frame$ID)
    tkbind(int.frame, "<Configure>", function() scrollframe_resize(int.frame))

    ## Save this so items can be put in it
    assign("interior.frame", int.frame, envir=rdenv())

    return(frame)
}


scrollframe_resize <- function(iframe) {
    stopifnot(tclvalue(tkwinfo.class(iframe)) == "Frame")

    w <- tkwinfo.width(iframe)
    h <- tkwinfo.height(iframe)

    vport <- tkwinfo.parent(iframe)
    stopifnot(tclvalue(tkwinfo.class(vport)) == "Canvas")
    bbox <- tkbbox(vport, "all")

    tkconfigure(vport,
                width=w,
                height=h,
                scrollregion=bbox,
                xscrollincrement="0.1i",
                yscrollincrement="0.1i")
}


scrollframe_interior <- function() {
    return(get("interior.frame", envir=rdenv()))
}


----------------------------------------------------------
SIGSIG -- signature too long (core dumped)