# -*- Mode: R -*-
works_with_R <- function(Rvers,...){
  pkg_need_have <- function(pkg,need,have){
    if(need != have){
      warning("need ",pkg," version ",need,", have ",have)
    }
  }
  pkg_need_have("R",Rvers,getRversion())
  pkg.vers <- list(...)
  for(pkg in names(pkg.vers)){
    pkg_need_have(pkg,pkg.vers[[pkg]],packageVersion(pkg))
    require(pkg,character.only=TRUE)
  }
}
  
options(repos=c(#"http://cran.miroir-francais.fr/",
          "http://mirror.ibcp.fr/pub/CRAN/",
          #"http://cran.univ-lyon1.fr/",
          "http://cran.r-project.org"),
        browser="firefox",
        mc.cores=4)
if(nchar(Sys.getenv("PYTHONPATH"))==0){
  Sys.setenv(PYTHONPATH=paste(sprintf("%s/lib/python2.%d/site-packages",
               Sys.getenv("HOME"),c(5,6)),collapse=":"))
}
if(interactive()){
  require(grDevices)
  X11.options(type="cairo")
  at.inria <- Sys.getenv("USER")=="hocking"
  tryCatch({
    if(at.inria){
      x11(width=20,height=15,xpos=-1,ypos=-1)
    }else{
      x11(xpos=-1,ypos=-1)
    }
  },error=function(e){
    "no window system available"
  })
  at.curie <- !at.inria
  library(lattice)

  ## load a package, from local or CRAN, or fail.
  library.install <- function(x,repos=getOption("repos"),type="source"){
    if(!require(x,character.only=TRUE)){
      install.packages(x,repos=repos,type=type)
      library(x,character.only=TRUE) ## library fails if pkg not found
    }
  }
  
  lattice.options(print.function = function(x, ...) {
    if ( (length(dim(x)) == 2) && require(latticeExtra) ){
      plot(useOuterStrips(x),...)
    }else{
      plot(x, ...)
    }
  },default.args=list(as.table=TRUE,
      strip=strip.custom(strip.names=TRUE),
      strip.left=strip.custom(strip.names=TRUE)))
  if(require(RColorBrewer)){
    require(grDevices)
    custom.pal <- brewer.pal(9,"Set1")
    custom.pal[6] <- "#DDDD33"
    trellis.par.set(theme=simpleTheme(col=custom.pal))
    ##show.settings()
  }
  if(require(ggplot2)){
    theme_set(theme_bw())
    facet_grid_label <- function(f,...){
      facet_grid(f,labeller=function(var,val)sprintf("%s : %s",var,val))
    }
  }

  regexpr.groups <- function(pattern,string){
    str_match_perl(string,pattern)[,-1]
  }
  gregexpr.groups <- function(pattern,string){
    lists <- str_match_all_perl(string,pattern)
    lapply(lists,function(m)m[,-1])
  }
  str_match_perl <- function(string,pattern){
    parsed <- regexpr(pattern,string,perl=TRUE)
    captured.text <- substr(string,parsed,parsed+attr(parsed,"match.length")-1)
    captured.text[captured.text==""] <- NA
    captured.groups <- do.call(rbind,lapply(seq_along(string),function(i){
      st <- attr(parsed,"capture.start")[i,]
      if(is.na(parsed[i]) || parsed[i]==-1)return(rep(NA,length(st)))
      substring(string[i],st,st+attr(parsed,"capture.length")[i,]-1)
    }))
    result <- cbind(captured.text,captured.groups)
    colnames(result) <- c("",attr(parsed,"capture.names"))
    result
  }
  str_match_all_perl <- function(string,pattern){
    parsed <- gregexpr(pattern,string,perl=TRUE)
    lapply(seq_along(parsed),function(i){
      r <- parsed[[i]]
      starts <- attr(r,"capture.start")
      if(r[1]==-1)return(matrix(nrow=0,ncol=1+ncol(starts)))
      names <- attr(r,"capture.names")
      lengths <- attr(r,"capture.length")
      full <- substring(string[i],r,r+attr(r,"match.length")-1)
      subs <- substring(string[i],starts,starts+lengths-1)
      m <- matrix(c(full,subs),ncol=length(names)+1)
      colnames(m) <- c("",names)
      m
    })
  }
  get.first <- function(html,before,match){
    pattern <- sprintf("%s(%s)",before,match)
    p <- regexpr(pattern,html,perl=TRUE)
    st <- attr(p,"capture.start")
    substr(html,st,st+attr(p,"capture.length")-1)
  }
}