[Rd] Bug in R 1.1.1 dev.print() with fix (PR#737)

[frost@pocketmail.com]

Full_Name: Keith L. Frost
Version: 1.1.1
OS: Linux Mandrake 7.1
Submission from: (NULL) (199.182.77.3)


x <- 1:256;
dim(x) <- c(16,16);
image(x,col=gray(0:255/255));
dev.print();

Sometimes errored out with a complaint about hp not defined.  I looked at the 
source code for dev.print, and found that in 3--4 places, variable names for 
paper width and height were mistakenly named wp and wh, instead of wp and hp.
Changing references to wh to references to hp fixed the problem.
Here is the new version of dev.print:

function (device = postscript, ...)
{
    current.device <- dev.cur()
    nm <- names(current.device)[1]
    if (nm == "null device")
        stop("no device to print from")
    if (nm != "X11" && nm != "windows" && nm != "gtk" && nm !=
        "gnome")
        stop("can only print from screen device")
    oc <- match.call()
    oc[[1]] <- as.name("dev.copy")
    oc$device <- device
    din <- par("din")
    w <- din[1]
    h <- din[2]
    if (missing(device)) {
        if (is.null(oc$file))
            oc$file <- ""
        hz <- oc$horizontal
        wp <- 8
        hp <- 10
        paper <- oc$paper
        if (is.null(paper))
            paper <- ps.options()$paper
        if (paper == "default")
            paper <- getOption("papersize")
        paper <- tolower(paper)
        if (paper == "a4") {
            wp <- 8
            hp <- 14 - 0.5
        }
        if (paper == "legal") {
            wp <- 8.27 - 0.5
            hp <- 11.69 - 0.5
        }
        if (paper == "executive") {
            wp <- 7.25 - 0.5
            hp <- 10.5 - 0.5
        }
        if (is.null(hz))
            hz <- ps.options()$horizontal
        if (w > wp && w < hp && h < wp) {
            horizontal <- TRUE
        }
        else if (h > wp && h < hp && w < wp) {
            horizontal <- FALSE
        }
        else {
            h0 <- ifelse(hz, wp, hp)
            if (h > h0) {
                w <- w * h0/h
                h <- h0
            }
            w0 <- ifelse(hz, hp, wp)
            if (w > w0) {
                h <- h * w0/w
                w <- w0
            }
        }
        if (is.null(oc$pointsize)) {
            pt <- ps.options()$pointsize
            oc$pointsize <- pt * w/din[1]
        }
    }
    if (is.null(oc$width))
        oc$width <- w
    if (is.null(oc$height))
        oc$height <- h
    dev.off(eval.parent(oc))
    dev.set(current.device)
} 


-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._