boxGrob <- function(tname, # table name
                    cnames, # column names
                    x=0.5, y=0.5,
                    default.units="npc",
                    just="centre",
                    gap=1.5*stringWidth(" "), 
                    primary=NULL, # which columns are part of the primary key
                    foreign=NULL, # which columns are foreign keys
                    gp=NULL, vp=NULL, name=tname) {
    if (!is.unit(x))
        x <- unit(x, default.units)
    if (!is.unit(y))
        y <- unit(y, default.units)
    grob(x=x, y=y, tname=tname, cnames=cnames,
         just=just, gap=gap,
         primary=primary, foreign=foreign,
         gp=gp, vp=vp, name=name, cl="box")
}

validDetails.box <- function(x) {
    if (!is.unit(x$x) ||
        !is.unit(x$y) ||
        !is.unit(x$gap))
        stop("'x', 'y', and 'gap' must be units")
    valid.just(x$just)
    # Make sure that x and y are of length 1
    if (length(x$x) != 1 | length(x$y) != 1)
        stop("'x' and 'y' must have length 1")
    # Make sure that primary and foreign are columns
    if (!(all(x$primary %in% x$cnames) &&
          all(x$primary %in% x$cnames)))
        stop("'primary' and 'foreign' must name existing columns")
    x
}

boxGrobs <- function(x) {
    nlines <- length(x$cnames) + 1
    tgrob <- textGrob(x$tname,
                      x=x$gap,
                      y=unit(nlines - .5, "lines"),
                      just="left",
                      gp=gpar(fontface="bold"))
    cfontface <- ifelse(x$cnames %in% x$primary,
                        ifelse(x$cnames %in% x$foreign,
                               "bold.italic",
                               "bold"),
                        ifelse(x$cnames %in% x$foreign,
                               "italic",
                               "plain"))
    cgrob <- textGrob(x$cnames,
                      x=x$gap,
                      y=unit((nlines - 1):1 - .5, "lines"),
                      just="left",
                      gp=gpar(fontface=cfontface))
    list(tgrob=tgrob, cgrob=cgrob)
}

drawDetails.box <- function(x, recording) {
    nlines <- length(x$cnames) + 1
    grobs <- boxGrobs(x)
    height <- unit(nlines, "lines")
    width <- 2*x$gap + max(unit.c(grobWidth(grobs$cgrob),
                                  grobWidth(grobs$tgrob)))
    pushViewport(viewport(x=x$x, y=x$y, width=width, height=height,
                          just=x$just, name=x$tname))
    # Table name
    grid.clip(y=unit(nlines - 1, "lines"), just="bottom",
              width=1.5)
    grid.roundrect(gp=gpar(fill="grey"))
    grid.draw(grobs$tgrob)
    # Column names
    for (i in seq_along(x$cnames)) {
        grid.clip(y=unit(nlines - i, "lines"), just="top",
                  width=1.5)
        grid.roundrect(gp=gpar(fill=c("grey90", "white")[i %% 2 + 1]))
    }
    grid.clip()
    grid.lines(0:1, unit(nlines - 1, "lines"))
    grid.draw(grobs$cgrob)
    popViewport()
}

xDetails.box <- function(x, theta) {
    nlines <- length(x$cnames) + 1
    grobs <- boxGrobs(x)
    height <- unit(nlines, "lines")
    width <- 2*x$gap + max(unit.c(grobWidth(grobs$cgrob),
                                  grobWidth(grobs$tgrob)))
    xDetails(rectGrob(x=x$x, y=x$y, just=x$just, width=width, height=height),
             theta)    
}

yDetails.box <- function(x, theta) {
    nlines <- length(x$cnames) + 1
    grobs <- boxGrobs(x)
    height <- unit(nlines, "lines")
    width <- 2*x$gap + max(unit.c(grobWidth(grobs$cgrob),
                                     grobWidth(grobs$tgrob)))
    yDetails(rectGrob(x=x$x, y=x$y, just=x$just, width=width, height=height),
             theta)    
}

widthDetails.box <- function(x) {
    grobs <- boxGrobs(x)
    2*x$gap + max(unit.c(grobWidth(grobs$cgrob),
                         grobWidth(grobs$tgrob)))
}

heightDetails.box <- function(x) {
    unit(length(x$cnames) + 1, "lines")
}

grid.box <- function(...) {
    grid.draw(boxGrob(...))
}


