From c35103493494c232bbbbe8cfc0a02f0184dec2df Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Tue, 21 Jun 2016 19:01:27 +0800
Subject: [PATCH 01/12] Refactor chart_Series to use plot.xts

As graphical parameter in .chob() environment are similar to .xts_chob()
in plot.xts, those parameter settings are replaced by plot.xts and
range.bars is called at the end to create candlesticks wrapped in
expression. In chart_Series.R, the add_* functions are also refactored
to obtain current plot object by calling xts:::current.xts_chob instead
of quantmod:::current.chob.
---
 R/chart_Series.R | 323 +++++++++++++++--------------------------------
 1 file changed, 103 insertions(+), 220 deletions(-)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index 38a7ca66..c86c2c74 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -1,7 +1,7 @@
 findOHLC <- function() {
-  chob <- current.chob()
+  chob <- xts:::current.xts_chob()
   loc <- round(locator(1)$x)
-  ohlc <- current.chob()$Env$xdata[current.chob()$Env$xsubset][loc]
+  ohlc <- chob$Env$xdata[chob$Env$xsubset][loc]
   actions <- chob$Env$actions
   envs <- lapply(actions[which(!sapply(actions,attr,'frame')%%2)],attr,'env')
   values <- lapply(lapply(envs[sapply(envs,is.list)],`[[`,1),
@@ -10,10 +10,10 @@ findOHLC <- function() {
 }
 
 getSubset <- function() {
-  chob <- current.chob()
+  chob <- xts:::current.xts_chob()
   from <- round(locator(1)$x)
   to <- round(locator(1)$x)
-  ohlc <- current.chob()$Env$xdata[current.chob()$Env$xsubset][from:to]
+  ohlc <- chob$Env$xdata[chob$Env$xsubset][from:to]
   actions <- chob$Env$actions
   envs <- lapply(actions[which(!sapply(actions,attr,'frame')%%2)],attr,'env')
   values <- lapply(lapply(envs[sapply(envs,is.list)],`[[`,1),
@@ -182,91 +182,48 @@ chart_Series <- function(x,
                          pars=chart_pars(), theme=chart_theme(),
                          clev=0,
                          ...) {
-  cs <- new.replot()
-  #cex <- pars$cex
-  #mar <- pars$mar
+  type0 <- type
+  major.ticks = "weeks"
+  grid.ticks.on = "weeks"
+  p <- plot.xts(x,
+                ...,
+                subset = subset,
+                main = name,
+                ylim = range(x[, 1, drop = FALSE]),
+                type = "n",
+                observation.based = TRUE,
+                major.ticks = major.ticks,
+                grid.ticks.on = grid.ticks.on)
+  if(is.character(x))
+    stop("'x' must be a time-series object")
+  if(is.OHLC(x)) {
+    p$Env$xdata <- OHLC(x)
+    if(has.Vo(x))
+      p$Env$vo <- Vo(x)
+  } else p$Env$xdata <- x
+
   line.col <- theme$col$line.col
   up.col <- theme$col$up.col
   dn.col <- theme$col$dn.col
   up.border <- theme$col$up.border
   dn.border <- theme$col$dn.border
   format.labels <- theme$format.labels
-  if(is.null(theme$grid.ticks.on)) {
-    xs <- x[subset]
-    major.grid <- c(years=nyears(xs),
-                    months=nmonths(xs),
-                    days=ndays(xs))
-    grid.ticks.on <- names(major.grid)[rev(which(major.grid < 30))[1]]
-  } else grid.ticks.on <- theme$grid.ticks.on
-  label.bg <- theme$col$label.bg
-  
-  cs$subset <- function(x) {
-    if(FALSE) {set_ylim <- get_ylim <- set_xlim <- Env<-function(){} }  # appease R parser?
-    if(missing(x)) {
-      x <- "" #1:NROW(Env$xdata)
-    }
-    Env$xsubset <<- x
-    set_xlim(c(1,NROW(Env$xdata[Env$xsubset])))
-    ylim <- get_ylim()
-    for(y in seq(2,length(ylim),by=2)) {
-      if(!attr(ylim[[y]],'fixed'))
-        ylim[[y]] <- structure(c(Inf,-Inf),fixed=FALSE)
-    }
-    lapply(Env$actions,
-           function(x) {
-             frame <- abs(attr(x, "frame"))
-             fixed <- attr(ylim[[frame]],'fixed')
-             #fixed <- attr(x, "fixed")
-             if(frame %% 2 == 0 && !fixed) {
-               lenv <- attr(x,"env")
-               if(is.list(lenv)) lenv <- lenv[[1]]
-               min.tmp <- min(ylim[[frame]][1],range(na.omit(lenv$xdata[Env$xsubset]))[1],na.rm=TRUE)
-               max.tmp <- max(ylim[[frame]][2],range(na.omit(lenv$xdata[Env$xsubset]))[2],na.rm=TRUE)
-               ylim[[frame]] <<- structure(c(min.tmp,max.tmp),fixed=fixed)
-             }
-           })
-    # reset all ylim values, by looking for range(env[[1]]$xdata)
-    # xdata should be either coming from Env or if lenv, lenv
-    set_ylim(ylim)
-  }
-  environment(cs$subset) <- environment(cs$get_asp)
-  if(is.character(x))
-    stop("'x' must be a time-series object")
-  if(is.OHLC(x)) {
-    cs$Env$xdata <- OHLC(x)
-    if(has.Vo(x))
-      cs$Env$vo <- Vo(x)
-  } else cs$Env$xdata <- x
-  #subset <- match(.index(x[subset]), .index(x))
-  cs$Env$xsubset <- subset
-  cs$Env$cex <- pars$cex
-  cs$Env$mar <- pars$mar
-  cs$set_asp(3)
-  cs$set_xlim(c(1,NROW(cs$Env$xdata[subset])))
-  cs$set_ylim(list(structure(range(na.omit(cs$Env$xdata[subset])),fixed=FALSE)))
-  cs$set_frame(1,FALSE)
-  cs$Env$clev = min(clev+0.01,1) # (0,1]
-  cs$Env$theme$bbands <- theme$bbands
-  cs$Env$theme$shading <- theme$shading
-  cs$Env$theme$line.col <- theme$col$line.col
-  cs$Env$theme$up.col <- up.col
-  cs$Env$theme$dn.col <- dn.col
-  cs$Env$theme$up.border <- up.border
-  cs$Env$theme$dn.border <- dn.border
-  cs$Env$theme$rylab <- theme$rylab
-  cs$Env$theme$lylab <- theme$lylab
-  cs$Env$theme$bg <- theme$col$bg
-  cs$Env$theme$grid <- theme$col$grid
-  cs$Env$theme$grid2 <- theme$col$grid2
-  cs$Env$theme$labels <- "#333333"
-  cs$Env$theme$label.bg <- label.bg
-  cs$Env$format.labels <- format.labels
-  cs$Env$ticks.on <- grid.ticks.on
-  cs$Env$grid.ticks.lwd <- theme$grid.ticks.lwd
-  cs$Env$type <- type
-
+  p$Env$theme$bbands <- theme$bbands
+  p$Env$theme$shading <- theme$shading
+  p$Env$theme$line.col <- line.col
+  p$Env$theme$up.col <- up.col
+  p$Env$theme$dn.col <- dn.col
+  p$Env$theme$up.border <- up.border
+  p$Env$theme$dn.border <- dn.border
+  p$Env$theme$rylab <- theme$rylab
+  p$Env$theme$lylab <- theme$lylab
+  p$Env$theme$bg <- theme$col$bg
+  p$Env$theme$grid <- theme$col$grid
+  p$Env$theme$grid2 <- theme$col$grid2
+  p$Env$theme$labels <- "#333333"
+  p$Env$ticks.on <- grid.ticks.on
   # axis_ticks function to label lower frequency ranges/grid lines
-  cs$Env$axis_ticks <- function(xdata,xsubset) {
+  p$Env$axis_ticks <- function(xdata,xsubset) {
     ticks <- diff(axTicksByTime2(xdata[xsubset],labels=FALSE))/2 + 
                   last(axTicksByTime2(xdata[xsubset],labels=TRUE),-1)
     if(!theme$coarse.time || length(ticks) == 1)
@@ -277,116 +234,42 @@ chart_Series <- function(x,
     ticks
   }
   # need to add if(upper.x.label) to allow for finer control
-  cs$add(expression(atbt <- axTicksByTime2(xdata[xsubset]),
-                    segments(atbt, #axTicksByTime2(xdata[xsubset]),
-                             get_ylim()[[2]][1],
-                             atbt, #axTicksByTime2(xdata[xsubset]),
-                             get_ylim()[[2]][2], col=theme$grid, lwd=grid.ticks.lwd),
+  p$add(expression(atbt <- axTicksByTime2(xdata[xsubset]),
                     axt <- axis_ticks(xdata,xsubset),
-                    text(as.numeric(axt),
-                         par('usr')[3]-0.2*min(strheight(axt)),
-                         names(axt),xpd=TRUE,cex=0.9,pos=3)),
-                    clip=FALSE,expr=TRUE)
-  cs$set_frame(-1)
+                    text(x=as.numeric(axt),
+                         y=par('usr')[3]-0.2*min(strheight(axt)),
+                         labels=unique(names(atbt)),xpd=TRUE,cex=0.9,pos=3)),
+         clip=FALSE, expr=TRUE, env=p$Env)
   # background of main window
-  #cs$add(expression(rect(par("usr")[1],
+  #p$add(expression(rect(par("usr")[1],
   #                       par("usr")[3],
   #                       par("usr")[2],
   #                       par("usr")[4],border=NA,col=theme$bg)),expr=TRUE)
-  cs$add_frame(0,ylim=c(0,1),asp=0.2)
-  cs$set_frame(1)
-
-  # add observation level ticks on x-axis if < 400 obs.
-  cs$add(expression(if(NROW(xdata[xsubset])<400) 
-          {axis(1,at=1:NROW(xdata[xsubset]),labels=FALSE,col=theme$grid2,tcl=0.3)}),expr=TRUE)
-
-  # add "month" or "month.abb"
-  cs$add(expression(axt <- axTicksByTime(xdata[xsubset],format.labels=format.labels),
-                axis(1,at=axt, #axTicksByTime(xdata[xsubset]),
-                labels=names(axt), #axTicksByTime(xdata[xsubset],format.labels=format.labels)),
-                las=1,lwd.ticks=1,mgp=c(3,1.5,0),tcl=-0.4,cex.axis=.9)),
-         expr=TRUE)
-  cs$Env$name <- name
-  text.exp <- c(expression(text(1-1/3,0.5,name,font=2,col='#444444',offset=0,cex=1.1,pos=4)),
-                expression(text(NROW(xdata[xsubset]),0.5,
-                           paste(start(xdata[xsubset]),end(xdata[xsubset]),sep=" / "),
-                           col=1,adj=c(0,0),pos=2)))
-  cs$add(text.exp, env=cs$Env, expr=TRUE)
-  cs$set_frame(2)
 
-  cs$Env$axis_labels <- function(xdata,xsubset,scale=5) {
-    axTicksByValue(na.omit(xdata[xsubset]))
-  }
-  cs$Env$make_pretty_labels <- function(ylim) {
-    p <- pretty(ylim,10)
-    p[p > ylim[1] & p < ylim[2]]
-  }
-  #cs$add(assign("five",rnorm(10)))  # this gets re-evaled each update, though only to test
-  #cs$add(expression(assign("alabels", axTicksByValue(na.omit(xdata[xsubset])))),expr=TRUE)
-  #cs$add(expression(assign("alabels", pretty(range(xdata[xsubset],na.rm=TRUE)))),expr=TRUE)
-  #cs$add(expression(assign("alabels", pretty(get_ylim(get_frame())[[2]],10))),expr=TRUE)
-  cs$add(expression(assign("alabels", make_pretty_labels(get_ylim(get_frame())[[2]]))),expr=TRUE)
-
-  # add $1 grid lines if appropriate
-  cs$set_frame(-2)
-
-  # add minor y-grid lines
-  cs$add(expression(if(diff(range(xdata[xsubset],na.rm=TRUE)) < 50)
-                    segments(1,seq(min(xdata[xsubset]%/%1,na.rm=TRUE),
-                                   max(xdata[xsubset]%/%1,na.rm=TRUE),1),
-                             length(xsubset),
-                               seq(min(xdata[xsubset]%/%1,na.rm=TRUE),
-                                   max(xdata[xsubset]%/%1,na.rm=TRUE),1),
-                             col=theme$grid2, lty="dotted")), expr=TRUE)
-  cs$set_frame(2)
-  # add main y-grid lines
-  cs$add(expression(segments(1,alabels,NROW(xdata[xsubset]),alabels, col=theme$grid)),expr=TRUE)
-  # left axis labels
-  if(theme$lylab) {
-    cs$add(expression(text(1-1/3-max(strwidth(alabels)),
-                alabels, #axis_labels(xdata,xsubset), 
-                noquote(format(alabels,justify="right")), 
-                col=theme$labels,offset=0,cex=0.9,pos=4,xpd=TRUE)),expr=TRUE)
-  }
-  # right axis labels
-  if(theme$rylab) {
-    cs$add(expression(text(NROW(xdata[xsubset])+1/3,
-                alabels, 
-                noquote(format(alabels,justify="right")),
-                col=theme$labels,offset=0,cex=0.9,pos=4,xpd=TRUE)),expr=TRUE)
-  }
-  # add main series
-  cs$set_frame(2)
-  # need to rename range.bars to something more generic, and allow type= to handle:
-  #  ohlc, hlc, candles, ha-candles, line, area
-  #  chart_Perf will be the call to handle relative performace plots
-  cs$add(expression(range.bars(xdata[xsubset], 
-                    type, 1,
-                    fade(theme$line.col,clev),
-                    fade(theme$up.col,clev),
-                    fade(theme$dn.col,clev),
-                    fade(theme$up.border,clev),
-                    fade(theme$dn.border,clev))),expr=TRUE)
-  assign(".chob", cs, .plotEnv)
-
-  # handle TA="add_Vo()" as we would interactively FIXME: allow TA=NULL to work
-  if(!is.null(TA) && nchar(TA) > 0) {
-  TA <- parse(text=TA, srcfile=NULL)
-  for( ta in 1:length(TA)) {
-    if(length(TA[ta][[1]][-1]) > 0) {
-    cs <- eval(TA[ta])
-    } else {
-    cs <- eval(TA[ta])
-    }
-  }
-  }
-  assign(".chob", cs, .plotEnv)
-  cs
+  if(!hasArg(spacing))
+    spacing = 1
+  p$Env$spacing = spacing
+  p$Env$line.col = line.col
+  p$Env$up.col = up.col
+  p$Env$dn.col = dn.col
+  p$Env$up.border = up.border
+  p$Env$type0 <- type0
+  p$Env$range.bars <- quantmod:::range.bars
+  exp <- expression(range.bars(xdata[xsubset],
+                               type=type0,
+                               spacing=spacing,
+                               line.col=line.col,
+                               up.col=up.col,
+                               dn.col=dn.col,
+                               up.border=up.border,
+                               dn.border=up.border))
+  p$add(exp, expr = TRUE, env = p$Env)
+  return(p)
 } #}}}
 
 # zoom_Chart {{{
 zoom_Chart <- function(subset) {
-  chob <- current.chob()
+  chob <- xts:::current.xts_chob()
   chob$subset(subset)
   chob
 }
@@ -430,9 +313,9 @@ add_Series <- function(x, type="candlesticks",order=NULL, on=NA, legend="auto",
         names(list(x=x,type=type,order=order,on=on,legend=legend,...)),
               list(x=x,type=type,order=order,on=on,legend=legend,...))
   exp <- parse(text=gsub("list","plot_series",
-               as.expression(substitute(list(x=current.chob(),type=type,series=get("x"), ...)))),
+               as.expression(substitute(list(x=xts:::current.xts_chob(),type=type,series=get("x"), ...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$theme <- if(is.null(theme)) plot_object$Env$theme else theme
   xdata <- plot_object$Env$xdata
   xsubset <- plot_object$Env$xsubset
@@ -455,11 +338,11 @@ add_Series <- function(x, type="candlesticks",order=NULL, on=NA, legend="auto",
     plot_object$add(expression(segments(1,alabels,NROW(xdata[xsubset]),alabels, col=theme$grid)),expr=TRUE)
   # left axis labels
     exp <- c(expression(text(1-1/3-max(strwidth(alabels)),
-                alabels, #axis_labels(xdata,xsubset), 
-                noquote(format(alabels,justify="right")), 
+                alabels, #axis_labels(xdata,xsubset),
+                noquote(format(alabels,justify="right")),
                 col=theme$labels,offset=0,cex=0.9,pos=4)),
              expression(text(NROW(upper.env$xdata[xsubset])+1/3,
-                alabels, 
+                alabels,
                 noquote(format(alabels,justify="right")),
                 col=theme$labels,offset=0,cex=0.9,pos=4)),exp)
 #    lenv$grid_lines <- function(xdata,x) { seq(-1,1) }
@@ -520,11 +403,11 @@ add_TA <- function(x, order=NULL, on=NA, legend="auto",
               list(x=x,order=order,on=on,legend=legend,
                    taType=taType,col=col,...))
   exp <- parse(text=gsub("list","plot_ta",
-               as.expression(substitute(list(x=current.chob(),
+               as.expression(substitute(list(x=xts:::current.xts_chob(),
                              ta=get("x"),on=on,
                              taType=taType,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   xdata <- plot_object$Env$xdata
   xsubset <- plot_object$Env$xsubset
   if(is.logical(x)) no.update <- TRUE else no.update <- FALSE
@@ -551,7 +434,7 @@ add_TA <- function(x, order=NULL, on=NA, legend="auto",
     plot_object$add_frame(ylim=range(na.omit(xdata)),asp=1)  # need to have a value set for ylim
     plot_object$next_frame()
   # add grid lines, using custom function for MACD gridlines
-  lenv$grid_lines <- function(xdata,xsubset) { 
+  lenv$grid_lines <- function(xdata,xsubset) {
     pretty(xdata[xsubset])
   }
   exp <- c(expression(segments(1,grid_lines(xdata,xsubset),NROW(xdata[xsubset]),grid_lines(xdata,xsubset),
@@ -596,9 +479,9 @@ add_SMA <- function(n=10, on=1, col='brown',...) {
     lines(1:NROW(xdata[xsubset]), ema, col=col,...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_sma",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_sma",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$xdata <- SMA(Cl(plot_object$Env$xdata),n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -614,9 +497,9 @@ add_EMA <- function(n=10, on=1, col='blue',...) {
     lines(1:NROW(xdata[xsubset]), ema, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_ema",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_ema",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$xdata <- EMA(Cl(plot_object$Env$xdata),n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -632,9 +515,9 @@ add_WMA <- function(n=10, wts=1:n, on=1, col='green',...) {
     lines(1:NROW(xdata[xsubset]), ema, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,wts=wts,col=col,...)), list(n=n,wts=wts,col=col,...))
-  exp <- parse(text=gsub("list","add_wma",as.expression(substitute(list(x=current.chob(),n=n,wts=wts,col=col,...)))),
+  exp <- parse(text=gsub("list","add_wma",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,wts=wts,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$xdata <- WMA(Cl(plot_object$Env$xdata),n=n,wts=wts)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -650,9 +533,9 @@ add_VMA <- function(w, ratio=1, on=1, col='green',...) {
     lines(1:NROW(xdata[xsubset]), vma, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(w=w,ratio=ratio,col=col,...)), list(w=w,ratio=ratio,col=col,...))
-  exp <- parse(text=gsub("list","add_wma",as.expression(substitute(list(x=current.chob(),w=w,ratio=ratio,col=col,...)))),
+  exp <- parse(text=gsub("list","add_wma",as.expression(substitute(list(x=xts:::current.xts_chob(),w=w,ratio=ratio,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$xdata <- VMA(Cl(plot_object$Env$xdata),w=w,ratio=ratio)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -668,9 +551,9 @@ add_DEMA <- function(n=10, on=1, col='pink', ...) {
     lines(1:NROW(xdata[xsubset]), dema, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,col=col,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_dema",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_dema",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$xdata <- DEMA(Cl(plot_object$Env$xdata),n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -687,9 +570,9 @@ add_VWAP <- function(n=10, on=1, col='darkgrey', ...) {
     lines(1:NROW(xdata[xsubset]), vwap, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,col=col,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_vwap",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_vwap",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$xdata <- VWAP(Cl(plot_object$Env$xdata),plot_object$Env$vo,n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -706,9 +589,9 @@ add_EVWMA <- function(n=10, on=1, col='darkgrey', ...) {
     lines(1:NROW(xdata[xsubset]), evwma, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,col=col,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_evwma",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_evwma",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$xdata <- EVWMA(Cl(plot_object$Env$xdata),plot_object$Env$vo,n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -728,9 +611,9 @@ add_GMMA <- function(short=c(3,5,8,10,12,15),long=c(30,35,40,45,50,60), on=1, co
       lines(1:NROW(xdata[xsubset]), gmma[,i], col=col[i],...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(short=short,long=long,col=col,...)), list(short=short,long=long,col=col,...))
-  exp <- parse(text=gsub("list","add_gmma",as.expression(substitute(list(x=current.chob(),short=short,long=long,col=col,...)))),
+  exp <- parse(text=gsub("list","add_gmma",as.expression(substitute(list(x=xts:::current.xts_chob(),short=short,long=long,col=col,...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   lenv$xdata <- GMMA(Cl(plot_object$Env$xdata), short=short, long=long)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -757,13 +640,13 @@ add_SMI <- function (n=13, nFast=25, nSlow=2, nSig=9, maType="EMA", bounded=TRUE
         names(list(n=n,nFast=nFast,nSlow=nSlow,nSig=nSig,maType=maType,bounded=bounded,...)),
               list(n=n,nFast=nFast,nSlow=nSlow,nSig=nSig,maType=maType,bounded=bounded,...))
   exp <- parse(text=gsub("list","plot_smi",
-               as.expression(substitute(list(x=current.chob(),
+               as.expression(substitute(list(x=xts:::current.xts_chob(),
                                              n=n,nFast=nFast,
                                              nSlow=nSlow,nSig=nSig,
                                              maType=maType,bounded=bounded,...)))),
                srcfile=NULL)
 
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   if(is.null(plot_object$Env$theme$smi)) {
     plot_object$Env$theme$smi$col$smi   <- "orange"
     plot_object$Env$theme$smi$col$signal <- "darkgrey"
@@ -834,11 +717,11 @@ add_RSI <- function (n=14, maType="EMA", wilder=TRUE, ..., RSIup=70, RSIdn=30) {
         names(list(n=n,maType=maType,wilder=wilder,...)),
               list(n=n,maType=maType,wilder=wilder,...))
   exp <- parse(text=gsub("list","plot_rsi",
-               as.expression(substitute(list(x=current.chob(),
+               as.expression(substitute(list(x=xts:::current.xts_chob(),
                                              n=n,maType=maType,wilder=wilder,...)))),
                srcfile=NULL)
 
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   if(is.null(plot_object$Env$theme$rsi)) {
     plot_object$Env$theme$rsi$col$rsi   <- "saddlebrown"
     plot_object$Env$theme$rsi$col$lines <- "orange2"
@@ -887,15 +770,15 @@ skeleton_TA <- function(on, arg, ...) {
          names(list(arg=arg,...)),
                list(arg=arg,...))
   exp <- parse(text=gsub("list","plot_ta",
-               as.expression(substitute(list(x=current.chob(),
+               as.expression(substitute(list(x=xts:::current.xts_chob(),
                                         arg=arg,
                                         ...)))), srcfile=NULL)
-  chob <- current.chob()
+  chob <- xts:::current.xts_chob()
   xsubset <- chob$Env$xsubset
   preFUN <- ""
   FUN <- ""
   postFUN <- ""
-  chob$add_frame(ylin=c(0,1),asp=0.15)
+  chob$add_frame(ylim=c(0,1),asp=0.15)
   chob$next_frame()
 }
 
@@ -923,7 +806,7 @@ add_MACD <- function(fast=12,slow=26,signal=9,maType="EMA",histogram=TRUE,...) {
       rect(x.pos-1/3, 0, x.pos+1/3, macd.hist, col=bar.col, border="grey", lwd=0.2, ...)  # base graphics call
     }
     # macd line
-    lines(x.pos, macd[,1], col=x$Env$theme$macd$macd, lwd=2,,lty=1,...) 
+    lines(x.pos, macd[,1], col=x$Env$theme$macd$macd, lwd=2,lty=1,...)
     # signal line
     lines(x.pos, macd[,2], col=x$Env$theme$macd$signal, lty=3,...) 
   }
@@ -936,12 +819,12 @@ add_MACD <- function(fast=12,slow=26,signal=9,maType="EMA",histogram=TRUE,...) {
   # exp will be what is re-evaluated during redrawing (subset, new TA, etc)
   # we need to build this piece by piece
   exp <- parse(text=gsub("list","plot_macd",
-               as.expression(substitute(list(x=current.chob(),fast=fast,slow=slow,signal=signal,maType=maType,
+               as.expression(substitute(list(x=xts:::current.xts_chob(),fast=fast,slow=slow,signal=signal,maType=maType,
                                              histogram=histogram,...)))),
                srcfile=NULL)
 
   # plot_object is the current list of actions, and chart 'state'
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
 
   # now we can evaluate plot_object, as the parse/substitute is behind us
 
@@ -1022,10 +905,10 @@ add_BBands <- function(n=20, maType="SMA", sd=2, on=-1, ...) {
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) },
          names(list(n=n,maType=maType,sd=sd,on=on,...)), list(n=n,maType=maType,sd=sd,on=on,...))
-  exp <- parse(text=gsub("list","plot_bbands",as.expression(substitute(list(x=current.chob(),n=n,maType=maType,
+  exp <- parse(text=gsub("list","plot_bbands",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,maType=maType,
                sd=sd,on=on,...)))),srcfile=NULL)
   # save data that is drawn on charts
-  chob <- current.chob()
+  chob <- xts:::current.xts_chob()
   xdata <- chob$Env$xdata
   lenv$xdata <- BBands(Cl(xdata),n=n, maType,sd)[,-4]  # pctB is bad for ylim calculation on subset
 
@@ -1067,9 +950,9 @@ add_Vo <- function(...) {
 
   # map all passed args (if any) to 'lenv' environment
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(...)), list(...))
-  exp <- parse(text=gsub("list","plot_vo",as.expression(substitute(list(x=current.chob(),...)))),
+  exp <- parse(text=gsub("list","plot_vo",as.expression(substitute(list(x=xts:::current.xts_chob(),...)))),
                srcfile=NULL)
-  plot_object <- current.chob()
+  plot_object <- xts:::current.xts_chob()
   xdata <- plot_object$Env$vo
   xsubset <- plot_object$Env$xsubset
   theme <- plot_object$theme

From d64df053fd24a3240c1f8019793401c54f3c0dbd Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Thu, 7 Jul 2016 01:08:06 +0800
Subject: [PATCH 02/12] Fix chart_Series bugs

Update current.chob to call xts:::current.xts_chob

This avoids changing multiple calls to current.chob with calls to
xts:::current.xts_chob, by simply calling xts:::current.xts_chob inside
the current.chob function call.

grid.ticks.on and major.ticks should be drawn based on the data length
instead of specifying "weeks" directly.

Signed-off-by: Eric Hung <naturalsmen@gmail.com>

Revert trailing whitespace changes

Signed-off-by: Eric Hung <naturalsmen@gmail.com>

Revert unnecessary changes to text() call

Signed-off-by: Eric Hung <naturalsmen@gmail.com>

Move stuff

Signed-off-by: Eric Hung <naturalsmen@gmail.com>

Assign using <- instead of =

Signed-off-by: Eric Hung <naturalsmen@gmail.com>

Use more informative name than 'type0'

Signed-off-by: Eric Hung <naturalsmen@gmail.com>
---
 R/chart_Series.R | 188 +++++++++++++++++++++++------------------------
 1 file changed, 94 insertions(+), 94 deletions(-)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index c86c2c74..3480aa9b 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -1,7 +1,7 @@
 findOHLC <- function() {
-  chob <- xts:::current.xts_chob()
+  chob <- current.chob()
   loc <- round(locator(1)$x)
-  ohlc <- chob$Env$xdata[chob$Env$xsubset][loc]
+  ohlc <- current.chob()$Env$xdata[current.chob()$Env$xsubset][loc]
   actions <- chob$Env$actions
   envs <- lapply(actions[which(!sapply(actions,attr,'frame')%%2)],attr,'env')
   values <- lapply(lapply(envs[sapply(envs,is.list)],`[[`,1),
@@ -10,10 +10,10 @@ findOHLC <- function() {
 }
 
 getSubset <- function() {
-  chob <- xts:::current.xts_chob()
+  chob <- current.chob()
   from <- round(locator(1)$x)
   to <- round(locator(1)$x)
-  ohlc <- chob$Env$xdata[chob$Env$xsubset][from:to]
+  ohlc <- current.chob()$Env$xdata[current.chob()$Env$xsubset][from:to]
   actions <- chob$Env$actions
   envs <- lapply(actions[which(!sapply(actions,attr,'frame')%%2)],attr,'env')
   values <- lapply(lapply(envs[sapply(envs,is.list)],`[[`,1),
@@ -182,48 +182,54 @@ chart_Series <- function(x,
                          pars=chart_pars(), theme=chart_theme(),
                          clev=0,
                          ...) {
-  type0 <- type
-  major.ticks = "weeks"
-  grid.ticks.on = "weeks"
-  p <- plot.xts(x,
+  line.col <- theme$col$line.col
+  up.col <- theme$col$up.col
+  dn.col <- theme$col$dn.col
+  up.border <- theme$col$up.border
+  dn.border <- theme$col$dn.border
+  format.labels <- theme$format.labels
+  label.bg <- theme$col$label.bg
+
+  if(is.OHLC(x)) {
+    yrange <- c(min(Lo(x),na.rm=TRUE),max(Hi(x),na.rm=TRUE))
+  } else yrange <- range(x[, 1], na.rm=TRUE)
+  cs <- plot.xts(x,
                 ...,
                 subset = subset,
                 main = name,
-                ylim = range(x[, 1, drop = FALSE]),
+                ylim = yrange,
                 type = "n",
                 observation.based = TRUE,
-                major.ticks = major.ticks,
-                grid.ticks.on = grid.ticks.on)
+                major.ticks = "auto",
+                grid.ticks.on = "auto")
   if(is.character(x))
     stop("'x' must be a time-series object")
   if(is.OHLC(x)) {
-    p$Env$xdata <- OHLC(x)
+    cs$Env$xdata <- OHLC(x)
     if(has.Vo(x))
-      p$Env$vo <- Vo(x)
-  } else p$Env$xdata <- x
+      cs$Env$vo <- Vo(x)
+  } else cs$Env$xdata <- x
+  cs$Env$theme$bbands <- theme$bbands
+  cs$Env$theme$shading <- theme$shading
+  cs$Env$theme$line.col <- theme$col$line.col
+  cs$Env$theme$up.col <- up.col
+  cs$Env$theme$dn.col <- dn.col
+  cs$Env$theme$up.border <- up.border
+  cs$Env$theme$dn.border <- dn.border
+  cs$Env$theme$rylab <- theme$rylab
+  cs$Env$theme$lylab <- theme$lylab
+  cs$Env$theme$bg <- theme$col$bg
+  cs$Env$theme$grid <- theme$col$grid
+  cs$Env$theme$grid2 <- theme$col$grid2
+  cs$Env$theme$labels <- "#333333"
+  cs$Env$theme$label.bg <- label.bg
+  cs$Env$format.labels <- format.labels
+  cs$Env$ticks.on <- cs$Env$grid.ticks.on
+  cs$Env$grid.ticks.lwd <- theme$grid.ticks.lwd
+  cs$Env$range.bars.type <- type
 
-  line.col <- theme$col$line.col
-  up.col <- theme$col$up.col
-  dn.col <- theme$col$dn.col
-  up.border <- theme$col$up.border
-  dn.border <- theme$col$dn.border
-  format.labels <- theme$format.labels
-  p$Env$theme$bbands <- theme$bbands
-  p$Env$theme$shading <- theme$shading
-  p$Env$theme$line.col <- line.col
-  p$Env$theme$up.col <- up.col
-  p$Env$theme$dn.col <- dn.col
-  p$Env$theme$up.border <- up.border
-  p$Env$theme$dn.border <- dn.border
-  p$Env$theme$rylab <- theme$rylab
-  p$Env$theme$lylab <- theme$lylab
-  p$Env$theme$bg <- theme$col$bg
-  p$Env$theme$grid <- theme$col$grid
-  p$Env$theme$grid2 <- theme$col$grid2
-  p$Env$theme$labels <- "#333333"
-  p$Env$ticks.on <- grid.ticks.on
   # axis_ticks function to label lower frequency ranges/grid lines
-  p$Env$axis_ticks <- function(xdata,xsubset) {
+  cs$Env$axis_ticks <- function(xdata,xsubset) {
     ticks <- diff(axTicksByTime2(xdata[xsubset],labels=FALSE))/2 + 
                   last(axTicksByTime2(xdata[xsubset],labels=TRUE),-1)
     if(!theme$coarse.time || length(ticks) == 1)
@@ -234,42 +240,36 @@ chart_Series <- function(x,
     ticks
   }
   # need to add if(upper.x.label) to allow for finer control
-  p$add(expression(atbt <- axTicksByTime2(xdata[xsubset]),
+  cs$add(expression(atbt <- axTicksByTime2(xdata[xsubset]),
                     axt <- axis_ticks(xdata,xsubset),
-                    text(x=as.numeric(axt),
-                         y=par('usr')[3]-0.2*min(strheight(axt)),
-                         labels=unique(names(atbt)),xpd=TRUE,cex=0.9,pos=3)),
-         clip=FALSE, expr=TRUE, env=p$Env)
-  # background of main window
-  #p$add(expression(rect(par("usr")[1],
-  #                       par("usr")[3],
-  #                       par("usr")[2],
-  #                       par("usr")[4],border=NA,col=theme$bg)),expr=TRUE)
+                    text(as.numeric(axt),
+                         par('usr')[3]-0.2*min(strheight(axt)),
+                         names(axt),xpd=TRUE,cex=0.9,pos=3)),
+                    clip=FALSE,expr=TRUE)
 
   if(!hasArg(spacing))
-    spacing = 1
-  p$Env$spacing = spacing
-  p$Env$line.col = line.col
-  p$Env$up.col = up.col
-  p$Env$dn.col = dn.col
-  p$Env$up.border = up.border
-  p$Env$type0 <- type0
-  p$Env$range.bars <- quantmod:::range.bars
+    spacing <- 1
+  cs$Env$spacing <- spacing
+  cs$Env$line.col <- line.col
+  cs$Env$up.col <- up.col
+  cs$Env$dn.col <- dn.col
+  cs$Env$up.border <- up.border
+  cs$Env$range.bars <- range.bars
   exp <- expression(range.bars(xdata[xsubset],
-                               type=type0,
+                               type=range.bars.type,
                                spacing=spacing,
                                line.col=line.col,
                                up.col=up.col,
                                dn.col=dn.col,
                                up.border=up.border,
                                dn.border=up.border))
-  p$add(exp, expr = TRUE, env = p$Env)
-  return(p)
+  cs$add(exp, expr = TRUE, env = cs$Env)
+  cs
 } #}}}
 
 # zoom_Chart {{{
 zoom_Chart <- function(subset) {
-  chob <- xts:::current.xts_chob()
+  chob <- current.chob()
   chob$subset(subset)
   chob
 }
@@ -283,7 +283,7 @@ fade <- function(col, level) {
   cols
 }
 
-current.chob <- function() invisible(get(".chob",.plotEnv))
+current.chob <- function() invisible(xts:::current.xts_chob())
 
 use.chob <- function(use=TRUE) {
   options('global.chob'=use) 
@@ -313,9 +313,9 @@ add_Series <- function(x, type="candlesticks",order=NULL, on=NA, legend="auto",
         names(list(x=x,type=type,order=order,on=on,legend=legend,...)),
               list(x=x,type=type,order=order,on=on,legend=legend,...))
   exp <- parse(text=gsub("list","plot_series",
-               as.expression(substitute(list(x=xts:::current.xts_chob(),type=type,series=get("x"), ...)))),
+               as.expression(substitute(list(x=current.chob(),type=type,series=get("x"), ...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$theme <- if(is.null(theme)) plot_object$Env$theme else theme
   xdata <- plot_object$Env$xdata
   xsubset <- plot_object$Env$xsubset
@@ -338,11 +338,11 @@ add_Series <- function(x, type="candlesticks",order=NULL, on=NA, legend="auto",
     plot_object$add(expression(segments(1,alabels,NROW(xdata[xsubset]),alabels, col=theme$grid)),expr=TRUE)
   # left axis labels
     exp <- c(expression(text(1-1/3-max(strwidth(alabels)),
-                alabels, #axis_labels(xdata,xsubset),
-                noquote(format(alabels,justify="right")),
+                alabels, #axis_labels(xdata,xsubset), 
+                noquote(format(alabels,justify="right")), 
                 col=theme$labels,offset=0,cex=0.9,pos=4)),
              expression(text(NROW(upper.env$xdata[xsubset])+1/3,
-                alabels,
+                alabels, 
                 noquote(format(alabels,justify="right")),
                 col=theme$labels,offset=0,cex=0.9,pos=4)),exp)
 #    lenv$grid_lines <- function(xdata,x) { seq(-1,1) }
@@ -403,11 +403,11 @@ add_TA <- function(x, order=NULL, on=NA, legend="auto",
               list(x=x,order=order,on=on,legend=legend,
                    taType=taType,col=col,...))
   exp <- parse(text=gsub("list","plot_ta",
-               as.expression(substitute(list(x=xts:::current.xts_chob(),
+               as.expression(substitute(list(x=current.chob(),
                              ta=get("x"),on=on,
                              taType=taType,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   xdata <- plot_object$Env$xdata
   xsubset <- plot_object$Env$xsubset
   if(is.logical(x)) no.update <- TRUE else no.update <- FALSE
@@ -434,7 +434,7 @@ add_TA <- function(x, order=NULL, on=NA, legend="auto",
     plot_object$add_frame(ylim=range(na.omit(xdata)),asp=1)  # need to have a value set for ylim
     plot_object$next_frame()
   # add grid lines, using custom function for MACD gridlines
-  lenv$grid_lines <- function(xdata,xsubset) {
+  lenv$grid_lines <- function(xdata,xsubset) { 
     pretty(xdata[xsubset])
   }
   exp <- c(expression(segments(1,grid_lines(xdata,xsubset),NROW(xdata[xsubset]),grid_lines(xdata,xsubset),
@@ -479,9 +479,9 @@ add_SMA <- function(n=10, on=1, col='brown',...) {
     lines(1:NROW(xdata[xsubset]), ema, col=col,...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_sma",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_sma",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$xdata <- SMA(Cl(plot_object$Env$xdata),n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -497,9 +497,9 @@ add_EMA <- function(n=10, on=1, col='blue',...) {
     lines(1:NROW(xdata[xsubset]), ema, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_ema",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_ema",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$xdata <- EMA(Cl(plot_object$Env$xdata),n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -515,9 +515,9 @@ add_WMA <- function(n=10, wts=1:n, on=1, col='green',...) {
     lines(1:NROW(xdata[xsubset]), ema, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,wts=wts,col=col,...)), list(n=n,wts=wts,col=col,...))
-  exp <- parse(text=gsub("list","add_wma",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,wts=wts,col=col,...)))),
+  exp <- parse(text=gsub("list","add_wma",as.expression(substitute(list(x=current.chob(),n=n,wts=wts,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$xdata <- WMA(Cl(plot_object$Env$xdata),n=n,wts=wts)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -533,9 +533,9 @@ add_VMA <- function(w, ratio=1, on=1, col='green',...) {
     lines(1:NROW(xdata[xsubset]), vma, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(w=w,ratio=ratio,col=col,...)), list(w=w,ratio=ratio,col=col,...))
-  exp <- parse(text=gsub("list","add_wma",as.expression(substitute(list(x=xts:::current.xts_chob(),w=w,ratio=ratio,col=col,...)))),
+  exp <- parse(text=gsub("list","add_wma",as.expression(substitute(list(x=current.chob(),w=w,ratio=ratio,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$xdata <- VMA(Cl(plot_object$Env$xdata),w=w,ratio=ratio)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -551,9 +551,9 @@ add_DEMA <- function(n=10, on=1, col='pink', ...) {
     lines(1:NROW(xdata[xsubset]), dema, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,col=col,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_dema",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_dema",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$xdata <- DEMA(Cl(plot_object$Env$xdata),n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -570,9 +570,9 @@ add_VWAP <- function(n=10, on=1, col='darkgrey', ...) {
     lines(1:NROW(xdata[xsubset]), vwap, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,col=col,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_vwap",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_vwap",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$xdata <- VWAP(Cl(plot_object$Env$xdata),plot_object$Env$vo,n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -589,9 +589,9 @@ add_EVWMA <- function(n=10, on=1, col='darkgrey', ...) {
     lines(1:NROW(xdata[xsubset]), evwma, col=col, ...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(n=n,col=col,...)), list(n=n,col=col,...))
-  exp <- parse(text=gsub("list","add_evwma",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,col=col,...)))),
+  exp <- parse(text=gsub("list","add_evwma",as.expression(substitute(list(x=current.chob(),n=n,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$xdata <- EVWMA(Cl(plot_object$Env$xdata),plot_object$Env$vo,n=n)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -611,9 +611,9 @@ add_GMMA <- function(short=c(3,5,8,10,12,15),long=c(30,35,40,45,50,60), on=1, co
       lines(1:NROW(xdata[xsubset]), gmma[,i], col=col[i],...)
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(short=short,long=long,col=col,...)), list(short=short,long=long,col=col,...))
-  exp <- parse(text=gsub("list","add_gmma",as.expression(substitute(list(x=xts:::current.xts_chob(),short=short,long=long,col=col,...)))),
+  exp <- parse(text=gsub("list","add_gmma",as.expression(substitute(list(x=current.chob(),short=short,long=long,col=col,...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   lenv$xdata <- GMMA(Cl(plot_object$Env$xdata), short=short, long=long)
   plot_object$set_frame(sign(on)*(abs(on)+1L))
   plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE)
@@ -640,13 +640,13 @@ add_SMI <- function (n=13, nFast=25, nSlow=2, nSig=9, maType="EMA", bounded=TRUE
         names(list(n=n,nFast=nFast,nSlow=nSlow,nSig=nSig,maType=maType,bounded=bounded,...)),
               list(n=n,nFast=nFast,nSlow=nSlow,nSig=nSig,maType=maType,bounded=bounded,...))
   exp <- parse(text=gsub("list","plot_smi",
-               as.expression(substitute(list(x=xts:::current.xts_chob(),
+               as.expression(substitute(list(x=current.chob(),
                                              n=n,nFast=nFast,
                                              nSlow=nSlow,nSig=nSig,
                                              maType=maType,bounded=bounded,...)))),
                srcfile=NULL)
 
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   if(is.null(plot_object$Env$theme$smi)) {
     plot_object$Env$theme$smi$col$smi   <- "orange"
     plot_object$Env$theme$smi$col$signal <- "darkgrey"
@@ -717,11 +717,11 @@ add_RSI <- function (n=14, maType="EMA", wilder=TRUE, ..., RSIup=70, RSIdn=30) {
         names(list(n=n,maType=maType,wilder=wilder,...)),
               list(n=n,maType=maType,wilder=wilder,...))
   exp <- parse(text=gsub("list","plot_rsi",
-               as.expression(substitute(list(x=xts:::current.xts_chob(),
+               as.expression(substitute(list(x=current.chob(),
                                              n=n,maType=maType,wilder=wilder,...)))),
                srcfile=NULL)
 
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   if(is.null(plot_object$Env$theme$rsi)) {
     plot_object$Env$theme$rsi$col$rsi   <- "saddlebrown"
     plot_object$Env$theme$rsi$col$lines <- "orange2"
@@ -770,10 +770,10 @@ skeleton_TA <- function(on, arg, ...) {
          names(list(arg=arg,...)),
                list(arg=arg,...))
   exp <- parse(text=gsub("list","plot_ta",
-               as.expression(substitute(list(x=xts:::current.xts_chob(),
+               as.expression(substitute(list(x=current.chob(),
                                         arg=arg,
                                         ...)))), srcfile=NULL)
-  chob <- xts:::current.xts_chob()
+  chob <- current.chob()
   xsubset <- chob$Env$xsubset
   preFUN <- ""
   FUN <- ""
@@ -819,12 +819,12 @@ add_MACD <- function(fast=12,slow=26,signal=9,maType="EMA",histogram=TRUE,...) {
   # exp will be what is re-evaluated during redrawing (subset, new TA, etc)
   # we need to build this piece by piece
   exp <- parse(text=gsub("list","plot_macd",
-               as.expression(substitute(list(x=xts:::current.xts_chob(),fast=fast,slow=slow,signal=signal,maType=maType,
+               as.expression(substitute(list(x=current.chob(),fast=fast,slow=slow,signal=signal,maType=maType,
                                              histogram=histogram,...)))),
                srcfile=NULL)
 
   # plot_object is the current list of actions, and chart 'state'
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
 
   # now we can evaluate plot_object, as the parse/substitute is behind us
 
@@ -905,10 +905,10 @@ add_BBands <- function(n=20, maType="SMA", sd=2, on=-1, ...) {
   }
   mapply(function(name,value) { assign(name,value,envir=lenv) },
          names(list(n=n,maType=maType,sd=sd,on=on,...)), list(n=n,maType=maType,sd=sd,on=on,...))
-  exp <- parse(text=gsub("list","plot_bbands",as.expression(substitute(list(x=xts:::current.xts_chob(),n=n,maType=maType,
+  exp <- parse(text=gsub("list","plot_bbands",as.expression(substitute(list(x=current.chob(),n=n,maType=maType,
                sd=sd,on=on,...)))),srcfile=NULL)
   # save data that is drawn on charts
-  chob <- xts:::current.xts_chob()
+  chob <- current.chob()
   xdata <- chob$Env$xdata
   lenv$xdata <- BBands(Cl(xdata),n=n, maType,sd)[,-4]  # pctB is bad for ylim calculation on subset
 
@@ -950,9 +950,9 @@ add_Vo <- function(...) {
 
   # map all passed args (if any) to 'lenv' environment
   mapply(function(name,value) { assign(name,value,envir=lenv) }, names(list(...)), list(...))
-  exp <- parse(text=gsub("list","plot_vo",as.expression(substitute(list(x=xts:::current.xts_chob(),...)))),
+  exp <- parse(text=gsub("list","plot_vo",as.expression(substitute(list(x=current.chob(),...)))),
                srcfile=NULL)
-  plot_object <- xts:::current.xts_chob()
+  plot_object <- current.chob()
   xdata <- plot_object$Env$vo
   xsubset <- plot_object$Env$xsubset
   theme <- plot_object$theme

From ec8e0ab8fd93d5bb19ecff14ff43481f3514fb56 Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Wed, 6 Jul 2016 15:39:08 +0800
Subject: [PATCH 03/12] Pass chart_pars() settings to plot.xts

Pass cex and mar arguments created by chart_pars() to plot.xts.
---
 R/chart_Series.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index 3480aa9b..4fc42c82 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -227,6 +227,8 @@ chart_Series <- function(x,
   cs$Env$ticks.on <- cs$Env$grid.ticks.on
   cs$Env$grid.ticks.lwd <- theme$grid.ticks.lwd
   cs$Env$range.bars.type <- type
+  cs$Env$cex <- pars$cex
+  cs$Env$mar <- pars$mar
 
   # axis_ticks function to label lower frequency ranges/grid lines
   cs$Env$axis_ticks <- function(xdata,xsubset) {

From e5aadb913f80def7e16be5b59579e71a5f20f17c Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Wed, 6 Jul 2016 15:46:30 +0800
Subject: [PATCH 04/12] Enable TA functionality

Use the original code of chart_Series to enable apply TA argument.

There is no special handling for TA in the previous commits. The original
code of chart_Series is used to handle TA but use 'seq_along' instead of
':' in loop.

If TA is zero length, 'for' loop still runs one iteration as 1:length(TA)
returns 1:0. So 'seq_along' is applied to avoid this issue.

To avoid getting 'expression()' or entering parse environment, if-else
statement is specified.
---
 R/chart_Series.R | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index 4fc42c82..da5e0070 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -266,6 +266,18 @@ chart_Series <- function(x,
                                up.border=up.border,
                                dn.border=up.border))
   cs$add(exp, expr = TRUE, env = cs$Env)
+  # handle TA="add_Vo()" as we would interactively FIXME: allow TA=NULL to work
+  if(!is.null(TA) && nchar(TA) > 0) {
+    TA <- parse(text=TA, srcfile=NULL)
+    for(ta in seq_along(TA)) {
+      if(length(TA[ta][[1]][-1]) > 0) {
+        cs <- eval(TA[ta])
+      } else {
+        cs <- eval(TA[ta])
+      }
+    }
+  }
+  assign(".xts_chob", cs, xts:::.plotxtsEnv)
   cs
 } #}}}
 

From 2ec488cc92dbe43c91d5585710a11eb810dbccf4 Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Wed, 6 Jul 2016 16:39:04 +0800
Subject: [PATCH 05/12] Enable transparency setting by clev

---
 R/chart_Series.R | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index da5e0070..686dcf0d 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -209,6 +209,7 @@ chart_Series <- function(x,
     if(has.Vo(x))
       cs$Env$vo <- Vo(x)
   } else cs$Env$xdata <- x
+  cs$Env$clev = min(clev+0.01,1) # (0,1]
   cs$Env$theme$bbands <- theme$bbands
   cs$Env$theme$shading <- theme$shading
   cs$Env$theme$line.col <- theme$col$line.col
@@ -260,11 +261,11 @@ chart_Series <- function(x,
   exp <- expression(range.bars(xdata[xsubset],
                                type=range.bars.type,
                                spacing=spacing,
-                               line.col=line.col,
-                               up.col=up.col,
-                               dn.col=dn.col,
-                               up.border=up.border,
-                               dn.border=up.border))
+                               line.col=fade(line.col, clev),
+                               up.col=fade(up.col, clev),
+                               dn.col=fade(dn.col, clev),
+                               up.border=fade(up.border, clev),
+                               dn.border=fade(up.border, clev)))
   cs$add(exp, expr = TRUE, env = cs$Env)
   # handle TA="add_Vo()" as we would interactively FIXME: allow TA=NULL to work
   if(!is.null(TA) && nchar(TA) > 0) {

From 7614d8804c501cb1f2720a2afdc6ff132b0eea59 Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Wed, 6 Jul 2016 23:58:24 +0800
Subject: [PATCH 06/12] Pass labels color to tickmark

---
 R/chart_Series.R | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index 686dcf0d..9cf11999 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -243,11 +243,10 @@ chart_Series <- function(x,
     ticks
   }
   # need to add if(upper.x.label) to allow for finer control
-  cs$add(expression(atbt <- axTicksByTime2(xdata[xsubset]),
-                    axt <- axis_ticks(xdata,xsubset),
+  cs$add(expression(axt <- axis_ticks(xdata,xsubset),
                     text(as.numeric(axt),
                          par('usr')[3]-0.2*min(strheight(axt)),
-                         names(axt),xpd=TRUE,cex=0.9,pos=3)),
+                         names(axt),xpd=TRUE,cex=0.9,pos=3,col=theme$labels)),
                     clip=FALSE,expr=TRUE)
 
   if(!hasArg(spacing))

From e016b8beb1431b07810ec05a9190900405b9072e Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Sun, 10 Jul 2016 17:36:23 +0800
Subject: [PATCH 07/12] Update range.bars to use multi.col

Add if-else statement to handle multi.col setting.

As chartSeries is going to be the wrapper for chart_Series which doesn't
share multi.col argument with chartSeries, special handling for multi.col
from quantmod:::chartSeries.chob is applied to range.bars which is called
by chart_Series.
---
 R/chart_Series.R | 57 +++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 44 insertions(+), 13 deletions(-)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index 9cf11999..4f92a556 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -97,8 +97,43 @@ function(x, type="", spacing=1, line.col="darkorange",
       lines(1:NROW(x),x[,i],lwd=2,col=line.col[i],lend=3,lty=1)
     return(NULL)
   }
-  bar.col <- ifelse(Opens < Closes, up.col, dn.col)
-  bar.border <- ifelse(Opens < Closes, up.border, dn.border)
+  # masked from chartSeries.chob to handle multi.col
+  # create a vector of colors
+  cs <- current.chob()
+  dn.up.col <- cs$Env$theme$dn.up.col
+  up.up.col <- cs$Env$theme$up.up.col
+  up.dn.col <- cs$Env$theme$up.dn.col
+  dn.dn.col <- cs$Env$theme$dn.dn.col
+  
+  dn.up.border <- cs$Env$theme$dn.up.border
+  up.up.border <- cs$Env$theme$up.up.border
+  up.dn.border <- cs$Env$theme$up.dn.border
+  dn.dn.border <- cs$Env$theme$dn.dn.border
+  multi.col <- cs$Env$multi.col
+  range.bars.type <- cs$Env$range.bars.type
+  if(isTRUE(multi.col) && range.bars.type != "line") {
+    last.Closes <- as.numeric(quantmod::Lag(Closes))
+    last.Closes[1] <- Closes[1]
+    # create vector of appropriate bar colors
+    bar.col <- ifelse(Opens < Closes,
+                      ifelse(Opens < last.Closes,
+                             dn.up.col,
+                             up.up.col),
+                      ifelse(Opens < last.Closes,
+                             dn.dn.col,
+                             up.dn.col))
+    # create vector of appropriate border colors
+    bar.border <- ifelse(Opens < Closes,
+                         ifelse(Opens < last.Closes,
+                                dn.up.border,
+                                up.up.border),
+                         ifelse(Opens < last.Closes,
+                                dn.dn.border,
+                                up.dn.border))
+  } else {
+    bar.col <- ifelse(Opens < Closes, up.col, dn.col)
+    bar.border <- ifelse(Opens < Closes, up.border, dn.border)
+  }
   
   x.pos <- spacing*(1:NROW(x))
   if( type %in% c("ohlc", "hlc")) {
@@ -251,20 +286,16 @@ chart_Series <- function(x,
 
   if(!hasArg(spacing))
     spacing <- 1
-  cs$Env$spacing <- spacing
-  cs$Env$line.col <- line.col
-  cs$Env$up.col <- up.col
-  cs$Env$dn.col <- dn.col
-  cs$Env$up.border <- up.border
+  cs$Env$theme$spacing <- spacing
   cs$Env$range.bars <- range.bars
   exp <- expression(range.bars(xdata[xsubset],
                                type=range.bars.type,
-                               spacing=spacing,
-                               line.col=fade(line.col, clev),
-                               up.col=fade(up.col, clev),
-                               dn.col=fade(dn.col, clev),
-                               up.border=fade(up.border, clev),
-                               dn.border=fade(up.border, clev)))
+                               spacing=theme$spacing,
+                               line.col=fade(theme$line.col, clev),
+                               up.col=fade(theme$up.col, clev),
+                               dn.col=fade(theme$dn.col, clev),
+                               up.border=fade(theme$up.border, clev),
+                               dn.border=fade(theme$up.border, clev)))
   cs$add(exp, expr = TRUE, env = cs$Env)
   # handle TA="add_Vo()" as we would interactively FIXME: allow TA=NULL to work
   if(!is.null(TA) && nchar(TA) > 0) {

From b6d2aef020d538051c86f89a3edb76e54c302c00 Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Mon, 11 Jul 2016 11:20:48 +0800
Subject: [PATCH 08/12] Pass line.type to range.bars

As chartSeries is now a wrapper for chart_Series which calls range.bars
to chart, line.type is passed to range.bars to handle different line types
when set type='l' or type='line' in chartSeries.
---
 R/chart_Series.R | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index 4f92a556..2580165e 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -93,8 +93,12 @@ function(x, type="", spacing=1, line.col="darkorange",
     }
   } else {
     line.col <- rep(line.col, length.out=NCOL(x))
+    if(is.null(cs$Env$line.type))
+      line.type <- "l"
+    else
+      line.type <- cs$Env$line.type
     for(i in 1:NCOL(x))
-      lines(1:NROW(x),x[,i],lwd=2,col=line.col[i],lend=3,lty=1)
+      lines(1:NROW(x),x[,i],lwd=2,col=line.col[i],lend=3,lty=1,type=line.type)
     return(NULL)
   }
   # masked from chartSeries.chob to handle multi.col
@@ -136,7 +140,7 @@ function(x, type="", spacing=1, line.col="darkorange",
   }
   
   x.pos <- spacing*(1:NROW(x))
-  if( type %in% c("ohlc", "hlc")) {
+  if(type %in% c("ohlc", "hlc")) {
     bar.border <- bar.col
     bar.border[is.na(bar.border)] <- up.border
   }

From de872eba91339dd3c6a3600e4579b7a2d760af69 Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Tue, 26 Jul 2016 16:56:18 +0800
Subject: [PATCH 09/12] Fix bug in subset functionality

When subset is assigned, y limit doesn't change with the range of subset of
the series. So the candlesticks will be smaller or bigger because y limit
doesn't change.

Subset x to update y limit.
---
 R/chart_Series.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index 2580165e..b0638445 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -230,8 +230,8 @@ chart_Series <- function(x,
   label.bg <- theme$col$label.bg
 
   if(is.OHLC(x)) {
-    yrange <- c(min(Lo(x),na.rm=TRUE),max(Hi(x),na.rm=TRUE))
-  } else yrange <- range(x[, 1], na.rm=TRUE)
+    yrange <- c(min(Lo(x[subset]),na.rm=TRUE),max(Hi(x[subset]),na.rm=TRUE))
+  } else yrange <- range(x[subset, 1], na.rm=TRUE)
   cs <- plot.xts(x,
                 ...,
                 subset = subset,

From ef12ccead181a1966380d0b57429ab00aca4b944 Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Wed, 3 Aug 2016 15:47:13 +0800
Subject: [PATCH 10/12] Fix zoom_Chart to draw subset series

New chart.lines function is given to fix error: 'x' and 'y' lengths
differ.

As x-axis and y-axis will not change with the subset series when using
plot_object$subset(), x-axis is fixed first.

x.pos is passed to x limit to control the number of subset series.
y limit is reset by specifying structured range of subset series.
---
 R/chart_Series.R | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index b0638445..e19165ba 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -318,8 +318,47 @@ chart_Series <- function(x,
 
 # zoom_Chart {{{
 zoom_Chart <- function(subset) {
+  # refactor xts:::chart.lines to make subset functionality work
+  chart.lines <- function (x, type = "l", lty = 1, lwd = 2, lend = 1, col = 1:10, 
+                           up.col = NULL, dn.col = NULL, legend.loc = NULL, ...) 
+  {
+    if (is.null(up.col)) 
+      up.col <- "green"
+    if (is.null(dn.col)) 
+      dn.col <- "red"
+    xx <- xts:::current.xts_chob()
+    switch(type, h = {
+      colors <- ifelse(x[, 1] < 0, dn.col, up.col)
+      lines(xx$Env$xycoords$x[match(index(x), index(xx$Env$xdata))], x[, 1], lwd = 2, col = colors, 
+            lend = lend, lty = 1, type = "h", ...)
+    }, p = , l = , b = , c = , o = , s = , S = , n = {
+      if (length(lty) < NCOL(x)) lty <- rep(lty, length.out = NCOL(x))
+      if (length(lwd) < NCOL(x)) lwd <- rep(lwd, length.out = NCOL(x))
+      if (length(col) < NCOL(x)) col <- rep(col, length.out = NCOL(x))
+      for (i in NCOL(x):1) {
+        lines(xx$Env$xycoords$x[match(index(x), index(xx$Env$xdata))], x[, i], type = type, lend = lend, 
+              col = col[i], lty = lty[i], lwd = lwd[i], ...)
+      }
+    }, {
+      warning(paste(type, "not recognized. Type must be one of\n
+                  'p', 'l', 'b, 'c', 'o', 'h', 's', 'S', 'n'.\n
+                  plot.xts supports the same types as plot.default,\n
+                  see ?plot for valid arguments for type"))
+    })
+    if (!is.null(legend.loc)) {
+      lc <- legend.coords(legend.loc, xx$Env$xlim, range(x, 
+                                                         na.rm = TRUE))
+      legend(x = lc$x, y = lc$y, legend = colnames(x), xjust = lc$xjust, 
+             yjust = lc$yjust, fill = col[1:NCOL(x)], bty = "n")
+    }
+  }
   chob <- current.chob()
+  x <- chob$Env$xdata
+  x.pos <- 1:NROW(x[subset])
+  chob$Env$chart.lines <- chart.lines
   chob$subset(subset)
+  chob$Env$xlim <- range(x.pos)
+  chob$Env$ylim[[2]] <- structure(range(x[subset], na.rm=TRUE), fixed=TRUE)
   chob
 }
 # }}}

From 4c1a341282f68401af266f481e7eb540ccd2bd67 Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Thu, 4 Aug 2016 17:05:43 +0800
Subject: [PATCH 11/12] Fix not find function "fade" bug

Pass fade() to the environment of the plot object created by xts::plot.xts.
---
 R/chart_Series.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index e19165ba..e4afd14c 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -292,6 +292,7 @@ chart_Series <- function(x,
     spacing <- 1
   cs$Env$theme$spacing <- spacing
   cs$Env$range.bars <- range.bars
+  cs$Env$fade <- fade
   exp <- expression(range.bars(xdata[xsubset],
                                type=range.bars.type,
                                spacing=theme$spacing,

From c8afa2300a8e8f5c5195ce6eca859734b53a3d8a Mon Sep 17 00:00:00 2001
From: Eric Hung <naturalsmen@gmail.com>
Date: Wed, 10 Aug 2016 17:25:07 +0800
Subject: [PATCH 12/12] Remove duplicate right-hand side axis labels of add_TA

Since chart_Series defaults to have axis labels on both sides, RHS labels
will overlap the existing RHS labels. Moreover, when blotter::chart.Posn
function is called, RHS labels of add_TA sometimes different from the
existing ones because it is added based on "Buys", and "Sells" series.
---
 R/chart_Series.R | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/R/chart_Series.R b/R/chart_Series.R
index e4afd14c..06ed88bd 100644
--- a/R/chart_Series.R
+++ b/R/chart_Series.R
@@ -542,15 +542,15 @@ add_TA <- function(x, order=NULL, on=NA, legend="auto",
       lenv$grid_lines <- function(xdata,xsubset) { 
         pretty(xdata[xsubset])
       }
-      exp <- c(exp,
+      #exp <- c(exp,
            # LHS
            #expression(text(1-1/3-max(strwidth(grid_lines(xdata,xsubset))),grid_lines(xdata,xsubset),
            #           noquote(format(grid_lines(xdata,xsubset),justify="right")),
            #           col=theme$labels,offset=0,pos=4,cex=0.9)),
            # RHS
-           expression(text(NROW(xdata[xsubset])+1/3,grid_lines(xdata,xsubset),
-                      noquote(format(grid_lines(xdata,xsubset),justify="right")),
-                      col=theme$labels,offset=0,pos=4,cex=0.9)))
+           #expression(text(NROW(xdata[xsubset])+1/3,grid_lines(xdata,xsubset),
+           #           noquote(format(grid_lines(xdata,xsubset),justify="right")),
+           #           col=theme$labels,offset=0,pos=4,cex=0.9)))
       #}
       plot_object$add(exp,env=c(lenv, plot_object$Env),expr=TRUE,no.update=no.update)
     }