##!
# Generates EmEditor syntax files for R language according to the current system
#
# Usage:
#   emeditor_syntax_file("R.esy")
#
# @varsion 1.0
# @date 2010-08-03
# @author Masashi Nakanishi
# @license GPL2

# @param file   a connection, or a character string naming the file, to be passed to cat().
# @param exact  logical. If TRUE predefined symbols are exactly identified (using regular expression) but the EmEditor may became too heavy.
# @param color  a vector of integer (length 4) indicating the colors in highlighting on EmEditor
emeditor_syntax_file <- function(file, exact=TRUE, color=c(3L,4L,5L,6L)) {
  append <- is.character(file) & (nchar(file) > 0)
  cat(c(
"; EmEditor syntax file for R language",
";",
"; This file is automatically generated with the script",
"; written by Masashi N. 2010-08-03",
";",
"#Highlight=on",
"#BeginTag=",
"#EndTag=",
"#CommentBegin=",
"#CommentEnd=",
"#LineComment1=#",
"#LineComment2=",
"#SingleQuote=on",
"#DoubleQuote=on",
"#ContinueQuote=on",
"#Escape=\\",
"#ScriptBegin=",
"#ScriptEnd=",
"#SpecialSyntax=off",
"#HighlightBraces=on",
"",
paste("#Keyword color=", color[1], ",word=", ifelse(exact, "off", "on"),
  ",rightall=off,case=on,insidetag=off,regexp=", ifelse(exact, "on", "off"), ",rightall2=off", sep="")
  ), file=file, sep="\n")

  output_symbols_in_package <- function(env) {
    syms <- ls(env, all.names=TRUE)
    syms <- syms[grep("^\\.?[a-zA-Z\\.][a-zA-Z0-9\\.]*$", syms)]
    if (exact) {
      syms <- gsub("\\.", "\\\\\\.", syms)
      syms <- paste("(?<![[:alnum:]\\._])", syms, "(?![[:alnum:]\\._])", sep="")
    }
    cat(";", environmentName(env), "\n", file=file, append=append)
    cat(syms, file=file, sep="\n", append=append)
    cat("\n", file=file, append=append)
  }
  env <- globalenv()
  emptyname <- environmentName(emptyenv())
  while (emptyname != environmentName(parent.env(env))) {
    env <- parent.env(env)
    output_symbols_in_package(env)
  }

  cat(c(
paste("#Keyword color=", color[2], ",word=off,rightall=off,case=on,insidetag=off,regexp=on,rightall2=off", sep=""),
"(?<![[:alnum:]\\._])(if|else|for|in|while|repeat|break|next)(?![[:alnum:]\\._])",
"",
paste("#Keyword color=", color[3], ",word=off,rightall=off,case=on,insidetag=off,regexp=on,rightall2=off", sep=""),
"(?<![[:alnum:]\\._])(TRUE|FALSE|Inf|NULL|NaN)(?![[:alnum:]\\._])",
"(?<![[:alnum:]\\._])(NA|NA_integer_|NA_real_)(?![[:alnum:]\\._])",
"(?<![[:alnum:]\\._])(NA_character_|NA_complex_)(?![[:alnum:]\\._])",
"",
paste("#Keyword color=", color[4], ",word=off,rightall=off,case=on,insidetag=off,regexp=on,rightall2=off", sep=""),
"(?<![[:alnum:]\\._])[-+]*0x[0-9a-fA-F\\.]+[Li]?(?![[:alnum:]\\._])",
"(?<![[:alnum:]\\._])[-+]*\\d+\\.?(?:[eE][-+]?\\d+)?[Li]?(?![[:alnum:]\\._])",
"(?<![[:alnum:]\\._])[-+]*\\d*\\.\\d+(?:[eE][-+]?\\d+)?[Li]?(?![[:alnum:]\\._])",
""
  ), file=file, sep="\n", append=append)
}