RwxWidgets: Interface to wxWidgets

#
# On my Linux box running as a VM on a MacBook Pro, this used to take
# about 5 and 1/2 minutes to run currently.  It gives many warnings
# but these are mainly for me and should not concern the user excessively.
#
# Run-times have been dramatically improved and then slowed down again.
# Hashing the DefinitionContainer  and using exists() at different levels
# yielded a dramatic improvement (72 minutes down to 5 minutes). More features
# have brought this up to 8.

#
#
# The resulting code gives two warnings about deprecated routines - GetItemSpacing and ParseWildcard.
#
# Fixed
#  repeats for wxBitmapButtonBase
#     these are the ones that return a const
#  Identify abstract classes.
#      wxChoiceBase() and wxControlWithItems()


# Find out which wx/ files are not included that we need
# splitter.h is one.
# Use GCC to calculate the dependencies and compare the list
# to the entire contents of the top-level directory of the include
# area and the generic/ and gtk/ specific directories.

library(RGCCTranslationUnit)

if(!exists("wxResolvedMethods")) {
autoGenerateDir = "."

sys = parseTU(paste(autoGenerateDir, "system.cpp.tu", sep = .Platform$file.sep))

sysDeclarations = getAllDeclarations(sys)
sysClasses = getClassNodes(sys)

topfiles = list.files("/usr/local/include/wx-2.6/wx", recursive = TRUE)
targets = gsub("\\.[^\\.]+$", "", topfiles)
targetFiles = basename(targets)


tu = parseTU(paste(autoGenerateDir, "wx.cpp.tu", sep = .Platform$file.sep))


if(FALSE) {  # skip all of this.
if(FALSE) {
   # This version uses the files to filter. 
  wxDeclarations = getAllDeclarations(tu, targets)
} else {
   # This one matches against the ones in 
  wxAllDeclarations = getAllDeclarations(tu)
  wxDeclarations = wxAllDeclarations[ !(names(wxAllDeclarations) %in% names(sysDeclarations)) ]
}
}


wxClasses = getClassNodes(tu, targetFiles)
  # Find the duplicates with sys
wxClasses = wxClasses[ !(names(wxClasses) %in% names(sysClasses))]


ignore =
  list(classes = c("_wxHashTable_NodeBase", "wxDllLoader",
                    "wxStringBase", "wxString", "wxStringBuffer",
                     "wxMBConv", "wxCharBuffer", "wxCSConv",
                    "wxArrayString",  "wxArrayShort", "wxArrayLong", "wxArrayPtr", "wxArrayPtrVoid", "wxWCharBuffer"))


if(length(ignore$classes)) 
  wxClasses = wxClasses [ !( names(wxClasses) %in% ignore$classes) ]


# Not used yet.
renameFunctions = c("assign" = "Assign")

#
TypeMap =
  typeMap("wxChar *" = list( #target = new("PointerType", name = "wxChar", depth = as.integer(1)),
               coerceRValue = "as.character",
               convertRValue = "RtowxChar",
               convertValueToR = "wxCharToR"
           ),
         "wxString" = list( #target = new("PointerType", name = "wxChar", depth = as.integer(1)),
               coerceRValue = "as.character",
               convertRValue = "R_to_wxString",
               convertValueToR = function(name, ...) { cat("converting wxString\n"); paste("wxStringToR(", name, ")")}
           ),          
      list(target = new("C++ReferenceType", name = "wxString", type = new("C++ClassDefinition", name = "wxString")),
           coerceRValue = "as.character",
           convertRValue = "R_from_wxString",
           convertValueToR = "R_as_wxString"
          ),
      list(target = new("PointerType", name = "wchar_t", depth = as.integer(1)),
           coerceRValue = "as.character",
           convertRValue = "to_wchar_t_from_R",
           convertValueToR = "wchar_t_ptr_to_R"
          ),          
      "wchar_t *" = list(coerceRValue = "as.character",
                         convertRValue = "to_wchar_t_from_R",
                         convertValueToR = "wchar_t_ptr_to_R")
   )


#  ,  .default = list(convertValueToR = function(name, parm, parameters, typeMap) {        })



##########################################################################


# our own local version.
createNativeReference =
  function(name, parm, typeName) {
       paste("R_make_wxWidget_Ref(", name, ', "', typeName, '");', sep = "")
 }
# assignInNamespace("createNativeReference", createNativeReference , "RGCCTranslationUnit")

derefNativeReference =
function(name, type, refName) {
   if(is(type, "PointerType"))
     type = type@type
  
  if(is(type, "TypeDefinition")) {
    type = type@name
  }
  
  paste("R_get_wxWidget_Ref(", name, ', "', type, '")', sep = "")
}

############################################################################

outArgs =
  list("SplitPath" = c(class = "wxFileName", param = "hasExt", type = "scalar", style = "out"),
       "PositionToXY" = c(class = "wxTextCtrl", param = list("x" = "scalar",
                                                             "y" = "scalar"), style = "out")
      )


cat("Starting the processing of the nodes\n")

# Find the descendants of wxWindow.
#XXX Why only wxWindow? What about the other classes?
#XXX what about the other classes, at least wxObject.
#XXX Is this actually filtering correctly.
widgetClasses = unique(names(wxClasses)[sapply(wxClasses, function(n) "wxWindow" %in% getBaseClasses(tu[[n]], recursive = TRUE))])

widgetClasses = names(wxClasses)
# Have to add "wxWindow" back to this unless we do
# names(wxClasses)[sapply(wxClasses,
#                          function(n)
#                            "wxWindow" %in% c(getNodeName(tu[[n]]), getBaseClasses(tu[[n]], recursive = TRUE))])
#


# Find all the methods for all the classes.

wxMethods = lapply(wxClasses[widgetClasses], function(n) getClassMethods(tu [[ n ]]))


# Generate the bindings, managing the types across methods and classes to avoid 
# resolving the same type multiple times.


# Note that by using exists() rather than  id %in% objects()
# we reduced the run time of this script (Sep 29 06) by a factor of 5!!!
# Profiling identified the objects() call as the primary time consumer and
# changing just 2 places in the code yielded changes in run time from
# 3769 seconds to 718.
# Go this down further by using hashed environments in the DefinitionContainer
# for managing the .resolved and .pending
# And a little more by using registered symbols in RSPerl via useDynLib().

types = DefinitionContainer(nodes = tu, verbose = FALSE)

abstractClasses = c("wxChoiceBase", "wxControlWithItems",
                    "wxHtmlWinTagHandler", "wxDC", "wxListBase"
# These ones are detected because of pure methods
#                     , "wxStatusBarBase", "wxNotebookBase",   "wxTopLevelWindowBase"
                   )

resolve.time = system.time(
            wxResolvedMethods <- lapply(wxMethods ,
                             function(m) {
                               lapply(m, resolveType, tu, types)
                             })
            )

wxIncludeDir = "/usr/local/include/wx-2.6"
classes = system(paste("grep -r 'DECLARE_NO_COPY_CLASS(' ", wxIncludeDir), intern = TRUE)
classes = gsub(".*:[ ]+DECLARE_NO_COPY_CLASS\\((.*)\\)$", "\\1", classes)
noCopyClasses = classes[ - grep(":", classes) ]



# See removeDuplicates in write.R

if(FALSE) 
wxResolvedMethods = lapply(names(wxResolvedMethods),
                        function(className) {
                           m = wxResolvedMethods[[className]]
                           ids = sapply(m, function(method) NativeMethodName(method$name, className, TRUE, method$parameters))
 # Is this necessary.                                
                           m[!duplicated(ids)]
                         })
names(wxResolvedMethods) = widgetClasses

}  # if !exists("wxResolvedMethods")

# determine which methods are overloaded.
#XXX add routines and check for overloading with these.
polymorphic = table(unlist(lapply(wxMethods, names)))
polymorphic = polymorphic[polymorphic > 1]



helperInfo = new.env(TRUE)
class(helperInfo) = "HelpInfo"

classBindings = lapply(widgetClasses,  
                       function(n)
                         createClassBindings(tu[[ wxClasses[n] ]], tu, n, types = types,
                                             polymorphicNames = names(polymorphic),
                                             abstract = abstractClasses,
                                             resolvedMethods = wxResolvedMethods[[ n ]],
                                             methods = wxMethods[[ n ]],
                                             typeMap = TypeMap, generateOverloaded = FALSE,
                                             helperInfo = helperInfo
                                            ))
names(classBindings) = widgetClasses

# Remove any empty entries. These show us objects of
# class list and there is no writeCode method.
idx = which(sapply(classBindings, length) == 0)
if(length(idx))
  classBindings = classBindings[ - idx ] 

# Check if the variable NoOutput is defined and if it is whether it is FALSE
# If so, don't generate the output.
if(!exists("NoOutput") || !NoOutput) {

globalConstants = computeGlobalConstants(tu, files = targetFiles)
includes = expandConstantIncludeFileNames(globalConstants$filenames, "/usr/local/include/wx-2.6/wx")
writeCode(globalConstants, "native", file = file.path(autoGenerateDir, "../inst/src/wxConstants.cpp"),
                            includes = paste("<", includes, ">", sep = ""))

                                        #c("<wx/wx.h>", "<wx/listbase.h>", "<wx/datetime.h>", "<wx/listctrl.h>"))

anonEnums = computeGlobalEnumConstants(tu, files = targetFiles)
writeCode(anonEnums, "r", file = file.path(autoGenerateDir, "../R/anonEnums.R"))


z = getDefines(".*", dir = "/usr/local/include/wx-2.6/wx")

dd = names(z)[duplicated(names(z))]
dups = lapply(dd, function(id)  z[names(z) == id])
dups = dups[sapply(dups, function(x) length(unique(x))) > 1]


# Dynamic casting from generic instance to specific.
# Both R and C++ code: setAs() in R and wxDynamicCast(x, type) in C++
do_wxDynamicCast =
  # For use with wxWidgets
function(var, className, target)
   paste(target, "=", "wxDynamicCast(", var, ", ", className, ");")

casts = lapply(widgetClasses, createDynamicCastCode, do_wxDynamicCast, "wxObject")


#XX Derived classes

# Want code in C/R that creates R variables with the constant primitive values.
#
con = file("tmp/RwxBindings.cpp", "w")
writeIncludes(c("<wx/wx.h>", "<wx/html/htmlwin.h>", "<Rinternals.h>", "<Rdefines.h>",
                '"RwxUtils.h"', '"Rwxdecl.h"'), con)

sapply(classBindings, writeCode, "native", file = con)
close(con)

con = file("tmp/RwxBindings.R", "w")
sapply(classBindings, writeCode, "r", file = con)
close(con)


RconversionRoutines = objects(helperInfo)
decls = sapply(RconversionRoutines,
                  function(id) {
                    obj = get(id, helperInfo)[[1]]
                    d = getNativeDeclaration("", PointerType(obj), addSemiColon = FALSE)
                     # Watch for duplicate constants. Can do this by looking at the qualifiers
                     # slot, but do it this way for the moment.
                    if(length(grep("^const", d)) == 0)
                      d = paste("const", d)
                    decl = paste("SEXP", id, "(",  d, ");")
                  })
declCon = file("Rwxdecl.h", "w")
cat(paste(decls, "\n"), file = declCon)
close(declCon)
}