[R-gui] Need Advice on Tcl/Tk Translation

[Paul Roebuck]

Did a quick (well, maybe not) translation of some example
code from section 4.2 of "Effective Tcl/Tk Programming".
I'm trying to learn how to write R scripts that use Tcl/Tk
and would like advice, pointers, suggestions based on
code below. Thanks for any help you could provide.


Translation left me with some questions about how best to
do a couple things with the tcltk package. Some questions
below are related to one another.

1) What's the best way to convert from a Tk widget id
back to R object? I used .Tk.newwin() as I didn't notice
anything more appropriate. Are there functions I missed
that return R objects instead?

2) Is there a method for finding a widget from a widget
hierarchy?

3) Better way to use tags on canvas widget? Don't seem
very useful in conjunction with R tcltk package.

4) tkitemconfigure() didn't seem to work for tag? What
did I do wrong? (scrollform_resize())

5) After resizing such that all form items were displayed,
clicking on the scrollbar arrows would still cause the
form to scroll.

6) What is the canonical means of accessing 'subwidgets'
(like 'form' from scrollform_create())? Global variables?


------------------------CODE------------------------------


###
### Translation of example from sect 4.2 of "Effective Tcl/Tk Programming"
###


require(tcltk)

scrollform_create <- function(top) {
    cat("scrollform_create()", "\n")
    frame <- tkframe(top, class="Scrollform")
    sbar <- tkscrollbar(frame,
                        command=function(...) tkyview(vport, ...))
    tkpack(sbar, side="right", fill="y")
    vport <- tkcanvas(frame,
                       yscrollcommand=function(...) tkset(sbar, ...))
    tkpack(vport, side="left", fill="both", expand=TRUE)
    form <- tkframe(vport, background="red")
    cat("internal form id:" , form$ID, "\n")
    tkcreate(vport, "window", "0 0", anchor="nw", window=form$ID)
    tkbind(form, "<Configure>", function() scrollform_resize(form))
    tkaddtag(vport, "iform", "all")

    iform.win <- tkitemconfigure(vport,
                                 tkfind(vport, "withtag", "iform"),
                                 "-window")
    cat("iform.win =", tclvalue(iform.win), "\n")

    return(frame)
}


## :WHY: If form is resized such that all items are displayed, why is the
## up arrow of scrollbar still active? Clicking on it scrolls frame
## downwards even though it is fully displayed...
scrollform_resize <- function(form) {
    cat("scrollform_resize()", "\n")
    stopifnot(tclvalue(tkwinfo("class", form)) == "Frame")
    vport <- tkwinfo("parent", form)
    stopifnot(tclvalue(tkwinfo("class", vport)) == "Canvas")

# this doesn't work either
#tkitemconfigure(vport, "iform", background="green")

    bbox <- tkbbox(vport, "all")
    cat("bbox:", tclvalue(bbox), "\n");

    w <- tkwinfo("width", form)
    tkconfigure(vport, width=w, scrollregion=bbox,
                yscrollincrement="0.1i")
}


scrollform_interior <- function() {
    cat("scrollform_interior()", "\n")
    return(form)    ## Would require global variable
}


## Given scrolled form widget, find its embedded "form" frame widget
## via hierarchy traversal. There must be a better way to do this...
get_scrollform_interior.hier <- function(sform) {
    cat("get_scrollform_interior.hier()", "\n")
    stopifnot(inherits(sform, "tkwin") && tclvalue(tkwinfo("class",
sform)) == "Scrollform")
    children.ids <- unlist(strsplit(tclvalue(tkwinfo("children", sform)),
" "))
    for (child.id in children.ids) {
        if (tclvalue(tkwinfo("class", child.id)) == "Canvas") {
            canvas.child.id <-
unlist(strsplit(tclvalue(tkwinfo("children", child.id)), " "))
            stopifnot(length(canvas.child.id) == 1)
            stopifnot(tclvalue(tkwinfo("class", canvas.child.id)) ==
"Frame")
            cat("iform.id =", canvas.child.id, "\n")
            form <- .Tk.newwin(canvas.child.id)   # convert Tk widget id
to R object?
            return(form)
        }
    }
}


## Given scrolled form widget, find its embedded "form" frame widget
## via tag reference. There must be a better way to do this...
get_scrollform_interior.tags <- function(sform) {
    cat("get_scrollform_interior.tags()", "\n")
    stopifnot(inherits(sform, "tkwin") && tclvalue(tkwinfo("class",
sform)) == "Scrollform")
    children.ids <- unlist(strsplit(tclvalue(tkwinfo("children", sform)),
" "))
    for (child.id in children.ids) {
        if (tclvalue(tkwinfo("class", child.id)) == "Canvas") {
            vport <- .Tk.newwin(child.id)
            iform.win <- tkitemconfigure(vport, tkfind(vport, "withtag",
"iform"), "-window")
            iform.id <- unlist(strsplit(tclvalue(iform.win), " "))[5]    #
...shudder...
            cat("iform.id =", iform.id, "\n")

            stopifnot(tclvalue(tkwinfo("class", iform.id)) == "Frame")
            form <- .Tk.newwin(iform.id)   # convert Tk widget id to R
object?
            return(form)
        }
    }
}

get_scrollform_interior <- get_scrollform_interior.tags
#debug(get_scrollform_interior)

toplevel <- tktoplevel()


main <- function() {
    tkpack(title <- tklabel(toplevel,
                            text="Enter Information in the form below:"),
           anchor="w")

    sform <- scrollform_create(toplevel)
    tkpack(sform, expand=TRUE, fill="both")
    #form <- scrollform_interior()
    form <- get_scrollform_interior(sform)

    tktitle(toplevel) <- "ScrForm Demo"

    fields <- c("Name:",
                "Address:",
                "City, State:",
                "Phone:",
                "FAX:",
                "E-mail:",
                "-",
                "SSN:",
                "Birthdate:",
                "Marital Status:",
                "-",
                "Employer:",
                "Occupation:",
                "Annual Income:",
                "-",
                "Emergency Contact:",
                "Phone:")
    for (field in fields) {
        if (field == "-") {
            line <- tkframe(form, height=2, borderwidth=1,
relief="sunken")
            tkpack(line,
                   fill="x",
                   padx=4,
                   pady=4)
        } else {
            line <- tkframe(form)
            label <- tklabel(line, text=field, width=20, anchor="e")
            tkpack(label, side="left")
            entry <- tkentry(line)
            tkpack(entry, fill="x")
            tkpack(line, side="top", fill="x")
        }
    }
}

## Run above code
main()

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