[R-SIG-Mac] BWidget missing

Paul Roebuck plroebuck at mdanderson.org
Tue Oct 13 21:39:45 CEST 2009


On Mon, 7 Sep 2009, Denis Chabot wrote:

> I installed all that was available when I installed R 2.9.2, including
> tcltk. However, I got this message upon loading PBSmodelling.
>
> I had a quick look at what Google found but it seems that I'd have to
> install this from source. Why would this particular part of tcltk need
> to be installed manually while the rest seems to be pre-installed
> (with the OS? by the R installer?).
>
>
> [R.app GUI 1.29 (5464) i386-apple-darwin8.11.1]
>
>  > library(PBSmodelling)
> Chargement de Tcl/Tk... terminé
>
> PBS Modelling 2.21 -- Copyright (C) 2005-2009 Fisheries and Oceans
> Canada
>
> A complete user guide 'PBSmodelling-UG.pdf' is located at
>   /Library/Frameworks/R.framework/Resources/library/PBSmodelling/doc/
> PBSmodelling-UG.pdf
>
> Packaged on Sun
> Pacific Biological Station, Nanaimo
>
> -------------------------------------------------------------
> ERROR: PBS Modelling requires the tcl package "BWidget"
> and cannot proceed until it is installed.
> Ubuntu (apt) users can install via the command:
> 	apt-get install bwidget
>
> -------------------------------------------------------------
> Warning message:
> In tclRequire("BWidget") : Tcl package 'BWidget' not found
>  > sessionInfo()
> R version 2.9.2 (2009-08-24)
> i386-apple-darwin8.11.1

[Attempting to set a new record for late responses...]


Denis,

Here's a script I wrote several years ago for dealing with
various Bioconductor GUIs that needed BWidget and Tktable
(which are Tcl Extension packages). Like browser plug-ins,
they add functionality not included in the base Tcl/Tk.

You will have to modify it to handle SnowLeopard yourself;
I have no access to 10.6 for testing it myself. Runs fine
on Tiger and Leopard for me.

----------------------------------------------------------
SIGSIG -- signature too long (core dumped)
-------------- next part --------------
###
### INSTALL_MACOSX_TKEXTENSIONS.R
###
### Installs OS X 32-bit X11 Tk extensions (used by various Bioconductor GUIs).
### Creates "$HOME/TkExtensions" folder.
###

local({

    options(warn=1)

    ##-------------------------------------------------------------------------
    unarchive <- function(what, where) {

        ##---------------------------------------------------------------------
        unzip <- function(what, where) {
            rc <- system(paste("unzip",
                               "-q",
                               path.expand(what),
                               "-d",
                               path.expand(where)), intern=FALSE)
            if (rc) {
                warning(sprintf("%s returned non-zero exit code %d",
                                sQuote("unzip"), rc),
                        domain=NA, call.=FALSE)
            }
        }

        ##---------------------------------------------------------------------
        ungztar <- function(what, where) {
            rc <- system(paste("tar",
                               "zxf",
                               path.expand(what),
                               "-C",
                               path.expand(where)), intern=FALSE)
            if (rc) {
                warning(sprintf("%s returned non-zero exit code %d",
                                sQuote("tar"), rc),
                        domain=NA, call.=FALSE)
            }
        }

        ##---------------------------------------------------------------------
        mount <- function(what) {
            rc <- system(paste("open",
                               path.expand(what)), intern=FALSE)
            if (rc) {
                warning(sprintf("%s returned non-zero exit code %d",
                                sQuote("open"), rc),
                        domain=NA, call.=FALSE)
            }
        }

        ##---------------------------------------------------------------------
        .unarchive <- function(what, where, suffix=c("dmg", "gz", "zip")) {
            suffix <- match.arg(suffix)
            switch(EXPR = suffix,
                   "dmg" = mount(what),
                   "zip" = unzip(what, where),
                   "gz"  = ungztar(what, where))
        }

        fnparts <- unlist(strsplit(what, ".", fixed=TRUE))
        suffix <- fnparts[length(fnparts)]
        .unarchive(what, where, suffix)
    }


    ##-------------------------------------------------------------------------
    download.and.unarchive <- function(url,
                                       pathname,
                                       shortname=basename(pathname)) {
        message(sprintf("downloading %s archive", sQuote(shortname)))
        if (download.file(url=url, destfile=pathname) != 0) {
            stop(sprintf("download of URL %s failed",
                         sQuote(url)),
                 call.=FALSE)
        }

        message(sprintf("unarchiving %s extension", sQuote(shortname)))
        ## in-place install
        unarchive(pathname, dirname(pathname))
        file.remove(pathname)
    }


    ##-------------------------------------------------------------------------
    isMacOSX <- function() {
        return(Sys.info()["sysname"] == "Darwin")
    }


    ##-------------------------------------------------------------------------
    isTigerDarwinRelease <- function() {
        osRelease <- Sys.info()["release"]  ## Darwin release
        firstTigerRelease   <- "8.0.0"      ## Corresponds to Mac OS X 10.4.0
        firstLeopardRelease <- "9.0.0"      ## Corresponds to Mac OS X 10.5.0

        return((compareVersion(osRelease, firstTigerRelease)   >= 0) &&
               (compareVersion(osRelease, firstLeopardRelease) <  0))
    }


    ##-------------------------------------------------------------------------
    isLeopardDarwinRelease <- function() {
        osRelease <- Sys.info()["release"]  ## Darwin release
        firstLeopardRelease     <-  "9.0.0" ## Corresponds to Mac OS X 10.5.0
        firstSnowLeopardRelease <- "10.0.0" ## Corresponds to Mac OS X 10.6.0

        return((compareVersion(osRelease, firstLeopardRelease) >= 0) &&
               (compareVersion(osRelease, firstSnowLeopardRelease) <  0))
    }


    ##-------------------------------------------------------------------------
    isSnowLeopardDarwinRelease <- function() {
        osRelease <- Sys.info()["release"]  ## Darwin release
        firstSnowLeopardRelease <- "10.0.0" ## Corresponds to Mac OS X 10.6.0
        firstUnnamedRelease     <- "11.0.0" ## Corresponds to Mac OS X 10.7.0

        return((compareVersion(osRelease, firstSnowLeopardRelease) >= 0) &&
               (compareVersion(osRelease, firstUnnamedRelease) <  0))
    }


    ##-------------------------------------------------------------------------
    isTigerRelease <- function() {
        osRelease <- system(paste("sw_vers", "-productVersion"), intern=TRUE)
        firstTigerRelease   <- "10.4.0"
        firstLeopardRelease <- "10.5.0"

        return((compareVersion(osRelease, firstTigerRelease)   >= 0) &&
               (compareVersion(osRelease, firstLeopardRelease) <  0))
    }


    ##-------------------------------------------------------------------------
    isLeopardRelease <- function() {
        osRelease <- system(paste("sw_vers", "-productVersion"), intern=TRUE)
        firstLeopardRelease     <- "10.5.0"
        firstSnowLeopardRelease <- "10.6.0"

        return((compareVersion(osRelease, firstLeopardRelease) >= 0) &&
               (compareVersion(osRelease, firstSnowLeopardRelease) <  0))
    }


    ##-------------------------------------------------------------------------
    isSnowLeopardRelease <- function() {
        osRelease <- system(paste("sw_vers", "-productVersion"), intern=TRUE)
        firstSnowLeopardRelease <- "10.6.0"
        firstUnnamedRelease     <- "10.7.0"

        return((compareVersion(osRelease, firstSnowLeopardRelease) >= 0) &&
               (compareVersion(osRelease, firstUnnamedRelease) <  0))
    }


    ##-------------------------------------------------------------------------
    isTigerOrLeopardRelease <- function() {
        return(isTigerRelease() || isLeopardRelease())
    }


    ##-------------------------------------------------------------------------
    is.dir <- function(x) {
        !is.na(isdir <- file.info(x)$isdir) & isdir
    }


    ##-------------------------------------------------------------------------
    safe.dir.create <- function(path) {
        if (!is.dir(path) && !dir.create(path, recursive=TRUE)) {
            stop(sprintf("cannot create directory %s", sQuote(path)))
        }
    }


    ## Ensure platform
    if (!isMacOSX()) {
        stop("this install script is Mac OS X-specific")
    }

    ## Ensure release
    if (!isTigerOrLeopardRelease()) {
        stop("this install script is specific to Mac OS X 10.4.x or 10.5.x")
    }

    ## Ensure Tcl/Tk installed
    test.canloadtcl <- try(require(tcltk), silent=TRUE)
    if (!test.canloadtcl) {
        warning("Tcl/Tk for X11 not installed on this machine")

        repos <- "http://cran.r-project.org"
        site.url <- paste(repos, "bin", "macosx", "tools", sep="/")

        ## Universal build for X11 (32-bit & 64-bit)
        ## Required for R-2.8.x or higher
        TclTkDiskImage.filename <- "tcltk-8.5.5-x11.dmg"  ## As of 2009/10/08

        TclTkDiskImage.pathname <- file.path(tempdir(), TclTkDiskImage.filename)
        TclTkDiskImage.url <- paste(site.url, TclTkDiskImage.filename, sep="/")

        message("downloading disk image with required software components")
        if (download.file(url=TclTkDiskImage.url,
                          destfile=TclTkDiskImage.pathname) != 0) {
            stop(sprintf("download of URL %s failed",
                         sQuote(url)),
                 call.=FALSE)
        }

        unarchive(TclTkDiskImage.pathname)
        installer <- file.path("", "Volumes", "TclTk", "tcltk.pkg")
        ## wait for OS to mount the disk image
        message("waiting for disk image to be mounted... ", appendLF=FALSE)
        while (!file.exists(installer)) {
            Sys.sleep(1)
        }
        message("ready")
        Sys.sleep(1)
        message("running the installer on the mounted disk image")
        system(paste("open", installer), intern=FALSE)
    }

    ## Ensure directory
    tkextdir <- file.path(path.expand("~"), "TkExtensions")
    if (!file.exists(tkextdir)) {
        message("creating personal Tk extensions directory")
        safe.dir.create(tkextdir)
    } else if (!is.dir(tkextdir)) {
        stop(sprintf("%s is not a directory", sQuote(tkextdir)))
    }

    ## Download and install
    BWidget.version <- "1.9.0"
    BWidget.site.url <- paste("http://downloads.sourceforge.net",
                              "project",
                              "tcllib",
                              "BWidget",
                              BWidget.version,
                              sep="/")
    BWidgetArchive.filename <- sprintf("BWidget-%s.zip", BWidget.version)
    BWidgetArchive.pathname <- file.path(tkextdir, BWidgetArchive.filename)
    BWidget.url <- paste(BWidget.site.url, BWidgetArchive.filename, sep="/")

    ## :NOTE: Tktable-2.10 available as source archive, no binary archive...
    TktableArchive.filename <- if (length(grep("ppc", .Platform$r_arch))) {
                                   "Tktable2.9MacOSX_X11.ppc.zip"
                               } else {
                                   "Tktable2.9MacOSX_X11.intel.tar.gz"
                               }
    Tktable.site.url <- paste("http://bioinf.wehi.edu.au", "affylmGUI", sep="/")
    TktableArchive.pathname <- file.path(tkextdir, TktableArchive.filename)
    Tktable.url <- paste(Tktable.site.url, TktableArchive.filename, sep="/")

    download.and.unarchive(BWidget.url, BWidgetArchive.pathname, "BWidget")
    download.and.unarchive(Tktable.url, TktableArchive.pathname, "Tktable")
})



More information about the R-SIG-Mac mailing list