[Sciviews-commits] r12 - / komodo komodo/SciViews-K komodo/SciViews-K/R komodo/SciViews-K/_prj_internal_ komodo/SciViews-K/content komodo/SciViews-K/content/js komodo/SciViews-K/content/js/tools komodo/SciViews-K/locale komodo/SciViews-K/locale/en-GB komodo/SciViews-K/locale/fr-FR komodo/SciViews-K/skin komodo/SciViews-K/skin/images komodo/SciViews-K/templates komodo/SciViews-K/templates/All Languages komodo/SciViews-K/templates/Common komodo/SciViews-K/toolbox komodo/SciViews-K Unit komodo/SciViews-K Unit/_prj_internal_ komodo/SciViews-K Unit/content komodo/SciViews-K Unit/content/js komodo/SciViews-K Unit/locale komodo/SciViews-K Unit/locale/en-GB komodo/SciViews-K Unit/locale/fr-FR komodo/SciViews-K Unit/skin pkg/svGUI pkg/svGUI/R pkg/svGUI/man pkg/svIDE pkg/svIDE/R pkg/svMisc pkg/svSocket pkg/svUnit pkg/svUnit/R pkg/svUnit/inst pkg/svUnit/inst/komodo pkg/svUnit/inst/unitTests pkg/svUnit/inst/unitTests/VirtualClass pkg/svUnit/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 23 03:33:09 CEST 2008
Author: phgrosjean
Date: 2008-06-23 03:33:08 +0200 (Mon, 23 Jun 2008)
New Revision: 12
Added:
komodo/
komodo/.DS_Store
komodo/SciViews-K Unit/
komodo/SciViews-K Unit/.DS_Store
komodo/SciViews-K Unit/SciViews-K Unit.kpf
komodo/SciViews-K Unit/_prj_internal_/
komodo/SciViews-K Unit/_prj_internal_/setup.xul
komodo/SciViews-K Unit/chrome.manifest
komodo/SciViews-K Unit/content/
komodo/SciViews-K Unit/content/js/
komodo/SciViews-K Unit/content/js/.DS_Store
komodo/SciViews-K Unit/content/js/sciviewskunit.js
komodo/SciViews-K Unit/content/overlay.xul
komodo/SciViews-K Unit/install.rdf
komodo/SciViews-K Unit/locale/
komodo/SciViews-K Unit/locale/.DS_Store
komodo/SciViews-K Unit/locale/en-GB/
komodo/SciViews-K Unit/locale/en-GB/.DS_Store
komodo/SciViews-K Unit/locale/en-GB/sciviewskunit.dtd
komodo/SciViews-K Unit/locale/fr-FR/
komodo/SciViews-K Unit/locale/fr-FR/.DS_Store
komodo/SciViews-K Unit/locale/fr-FR/sciviewskunit.dtd
komodo/SciViews-K Unit/sciviewskunit-0.6.0-ko.xpi
komodo/SciViews-K Unit/skin/
komodo/SciViews-K Unit/skin/.DS_Store
komodo/SciViews-K Unit/skin/sciviewskunit.css
komodo/SciViews-K/
komodo/SciViews-K/.DS_Store
komodo/SciViews-K/R/
komodo/SciViews-K/R/Rprofile
komodo/SciViews-K/SciViews-K.kpf
komodo/SciViews-K/_prj_internal_/
komodo/SciViews-K/_prj_internal_/setup.xul
komodo/SciViews-K/chrome.manifest
komodo/SciViews-K/content/
komodo/SciViews-K/content/.DS_Store
komodo/SciViews-K/content/js/
komodo/SciViews-K/content/js/prefs.js
komodo/SciViews-K/content/js/r.js
komodo/SciViews-K/content/js/robjects.js
komodo/SciViews-K/content/js/sciviews.js
komodo/SciViews-K/content/js/socket.js
komodo/SciViews-K/content/js/tools/
komodo/SciViews-K/content/js/tools/array.js
komodo/SciViews-K/content/js/tools/e4x2dom.js
komodo/SciViews-K/content/js/tools/strings.js
komodo/SciViews-K/content/overlay.xul
komodo/SciViews-K/install.rdf
komodo/SciViews-K/locale/
komodo/SciViews-K/locale/.DS_Store
komodo/SciViews-K/locale/en-GB/
komodo/SciViews-K/locale/en-GB/.DS_Store
komodo/SciViews-K/locale/en-GB/sciviewsk.dtd
komodo/SciViews-K/locale/fr-FR/
komodo/SciViews-K/locale/fr-FR/.DS_Store
komodo/SciViews-K/locale/fr-FR/sciviewsk.dtd
komodo/SciViews-K/sciviewsk-0.6.0-ko.xpi
komodo/SciViews-K/skin/
komodo/SciViews-K/skin/.DS_Store
komodo/SciViews-K/skin/images/
komodo/SciViews-K/skin/images/.DS_Store
komodo/SciViews-K/skin/images/array.png
komodo/SciViews-K/skin/images/body_bg_sav.gif
komodo/SciViews-K/skin/images/character.png
komodo/SciViews-K/skin/images/data.frame.png
komodo/SciViews-K/skin/images/dist.png
komodo/SciViews-K/skin/images/factor.png
komodo/SciViews-K/skin/images/function.png
komodo/SciViews-K/skin/images/integer.png
komodo/SciViews-K/skin/images/list.png
komodo/SciViews-K/skin/images/logical.png
komodo/SciViews-K/skin/images/matrix.png
komodo/SciViews-K/skin/images/numeric.png
komodo/SciViews-K/skin/images/objects.png
komodo/SciViews-K/skin/images/package.png
komodo/SciViews-K/skin/images/ts.png
komodo/SciViews-K/skin/sciviewsk.css
komodo/SciViews-K/templates/
komodo/SciViews-K/templates/.DS_Store
komodo/SciViews-K/templates/All Languages/
komodo/SciViews-K/templates/All Languages/.DS_Store
komodo/SciViews-K/templates/All Languages/R.R
komodo/SciViews-K/templates/Common/
komodo/SciViews-K/templates/Common/.DS_Store
komodo/SciViews-K/templates/Common/R S3 object.R
komodo/SciViews-K/templates/Common/R.R
komodo/SciViews-K/toolbox/
komodo/SciViews-K/toolbox/SciViews-K 0.6.0.kpz
komodo/TODO
pkg/svUnit/R/Log.R
pkg/svUnit/R/check.R
pkg/svUnit/R/guiTestReport.R
pkg/svUnit/R/koUnit.R
pkg/svUnit/R/svSuite.R
pkg/svUnit/R/svSuiteData.R
pkg/svUnit/R/svTestData.R
pkg/svUnit/R/svUnit-internal.R
pkg/svUnit/inst/komodo/
pkg/svUnit/inst/komodo/sciviewskunit-ko.xpi
pkg/svUnit/inst/unitTests/VirtualClass/runitVirtualClass.R
pkg/svUnit/inst/unitTests/runitsvSuite.R
pkg/svUnit/inst/unitTests/runitsvTest.R
pkg/svUnit/man/Log.Rd
pkg/svUnit/man/check.Rd
pkg/svUnit/man/guiTestReport.Rd
pkg/svUnit/man/koUnit.Rd
pkg/svUnit/man/svSuite.Rd
pkg/svUnit/man/svSuiteData.Rd
pkg/svUnit/man/svTestData.Rd
pkg/svUnit/man/svUnit-package.Rd
Removed:
pkg/svUnit/R/runUnit.R
pkg/svUnit/R/svUnit.R
pkg/svUnit/inst/unitTests/VirtualClass/runit.VirtualClass.R
pkg/svUnit/inst/unitTests/runit.svTest.R
pkg/svUnit/inst/unitTests/runit.svUnit.R
pkg/svUnit/man/runUnit.Rd
pkg/svUnit/man/svUnit.Rd
Modified:
pkg/svGUI/DESCRIPTION
pkg/svGUI/NEWS
pkg/svGUI/R/guiInstall.R
pkg/svGUI/R/guiUninstall.R
pkg/svGUI/R/koCmd.R
pkg/svGUI/TODO
pkg/svGUI/man/guiInstall.Rd
pkg/svGUI/man/koCmd.Rd
pkg/svIDE/DESCRIPTION
pkg/svIDE/R/TinnR.R
pkg/svIDE/TODO
pkg/svMisc/TODO
pkg/svSocket/TODO
pkg/svUnit/DESCRIPTION
pkg/svUnit/NAMESPACE
pkg/svUnit/NEWS
pkg/svUnit/R/svTest.R
pkg/svUnit/TODO
pkg/svUnit/man/svTest.Rd
pkg/svUnit/man/unitTests.Rd
Log:
svUnit finalized, addition of SciViews-K and SciViews-K Unit Komodo extensions and various other corrections
Added: komodo/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/R/Rprofile
===================================================================
--- komodo/SciViews-K/R/Rprofile (rev 0)
+++ komodo/SciViews-K/R/Rprofile 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,160 @@
+### SciViews install begin ###
+# SciViews-R installation and startup for running R with Komodo/SciViews-K
+# Merge this with your .Rprofile file in your home directory to configure
+# R automatically at startup
+
+# Make sure we don't process this twice in case of duplicate items in .Rprofile
+if (!exists(".SciViewsReady", envir = .GlobalEnv)) {
+ .SciViewsReady <- FALSE
+ minVersion <- c(R = "2.7.0", svMisc = "0.9-42", svSocket = "0.9-41", svGUI = "0.9-42")
+
+ # Configure socket client/server
+ options(ko.serve = 8888) # Port used by the R socket server
+ options(ko.host = "localhost") # Machine where Komodo is running (local only for the moment)
+ options(ko.port = 7052) # Port used by the Komodo socket server
+ options(ko.id = "R") # The id used for this R kernel in Komodo
+ options(ko.activate = FALSE) # Do we start/activate Komodo at startup?
+ # Note: set ko.activate to TRUE causes problems currently!
+
+ # Load main R packages
+ res <- require(methods, quietly = TRUE)
+ if (res) res <- require(datasets, quietly = TRUE)
+ if (res) res <- require(utils, quietly = TRUE)
+ if (res) res <- require(grDevices, quietly = TRUE)
+ if (res) res <- require(graphics, quietly = TRUE)
+ if (res) res <- require(stats, quietly = TRUE)
+ if (res) {
+ if (capabilities("tcltk")) {
+ # Make sure tcltk can start: on Mac OS X < 10.5 only,
+ # that is, darwin < 9, we need to check that X11 is installed
+ # (optional!) and started!
+ if (regexpr("^darwin[5-8]", R.Version()$os) > -1) {
+ # First, is the DISPLAY environment variable defined?
+ dis <- Sys.getenv("DISPLAY")
+ if (dis == "") {
+ Sys.setenv(DISPLAY = ":0") # Local X11
+ dis <- Sys.getenv("DISPLAY")
+ }
+ # Second, if DISPLAY points to a default local X11, make sure
+ # X11 is installed and started on this machine
+ if (dis %in% c(":0", ":0.0", "localhost:0", "localhost:0.0",
+ "127.0.0.1:0", "127.0.0.1:0.0")) {
+ # X11 is optional on Mac OS X 10.3 Panther and 10.4 Tiger!
+ # We locate 'open-x11' and run it,... not X11 directly!
+ if (length(system('find /usr/bin/ -name "open-x11"',
+ intern = TRUE)) == 0){
+ cat("'open-x11' not found. Make sure you installed X11\n")
+ cat("(see http://developer.apple.com/opensource/tools/runningx11.html\n")
+ res <- FALSE
+ } else { # Make sure X11 is started (trick: we try opening a non X11 prog)
+ system("open-x11 more", intern = TRUE)
+ }
+ }
+ rm(dis)
+ }
+ if (res) {
+ res <- suppressPackageStartupMessages(require(tcltk, quietly = TRUE))
+ if (!res) {
+ cat("Error starting tcltk. Make sure Tcl/Tk is installed and can\n")
+ cat("be run on your machine. Then, with packages svMisc, svSocket\n")
+ cat("and svGUI installed, restart R or type require(svGUI)\n")
+ }
+ }
+ } else cat("Tcl/Tk is required by SciViews, but it is not supported by this R installation\n")
+ } else cat("Problem loading standard R packages, check R installation\n")
+
+ if (res) {
+ # Check for R version
+ res <- compareVersion(paste(R.Version()$major, R.Version()$minor,
+ sep = "."), minVersion["R"])
+ if (res < 0) {
+ cat("R is too old for this version of SciViews, please, upgrade it\n")
+ } else {
+ # Load packages svMisc, svSocket & svGUI (possibly after installing
+ # or upgrading them). User is supposed to have agreed
+
+ ## svMisc
+ desc <- system.file("DESCRIPTION", package = "svMisc")
+ if (desc == "") {
+ cat("Trying to install missing package 'svMisc'\n")
+ install.packages("svMisc", repos = "http://R-Forge.R-project.org")
+ res <- require(svMisc, quietly = TRUE)
+ } else { # Check version
+ if ((compareVersion(packageDescription("svMisc", fields = "Version"),
+ minVersion["svMisc"]) < 0)) {
+ cat("Trying to update package 'svMisc'\n")
+ install.packages("svMisc", repos = "http://R-Forge.R-project.org")
+ }
+ res <- require(svMisc, quietly = TRUE)
+ }
+
+ ## svSocket
+ desc <- system.file("DESCRIPTION", package = "svSocket")
+ if (desc == "") {
+ cat("Trying to install missing package 'svSocket'\n")
+ install.packages("svSocket", repos = "http://R-Forge.R-project.org")
+ res[2] <- require(svSocket, quietly = TRUE)
+ } else { # Check version
+ if ((compareVersion(packageDescription("svSocket", fields = "Version"),
+ minVersion["svSocket"]) < 0)) {
+ cat("Trying to update package 'svSocket'\n")
+ install.packages("svSocket", repos = "http://R-Forge.R-project.org")
+ }
+ res[2] <- require(svSocket, quietly = TRUE)
+ }
+
+ ## svGUI
+ desc <- system.file("DESCRIPTION", package = "svGUI")
+ if (desc == "") {
+ cat("Trying to install missing package 'svGUI'\n")
+ install.packages("svGUI", repos = "http://R-Forge.R-project.org")
+ } else { # Check version
+ if ((compareVersion(packageDescription("svGUI", fields = "Version"),
+ minVersion["svGUI"]) < 0)) {
+ cat("Trying to update package 'svGUI'\n")
+ install.packages("svGUI", repos = "http://R-Forge.R-project.org")
+ }
+ }
+ rm(desc)
+
+ # Try starting the R socket server
+ if (inherits(try(startSocketServer(port = getOption("ko.serve")),
+ silent = TRUE), "try-error")) {
+ cat("Impossible to start the SciViews R socket server\n(socket",
+ getOption("ko.serve"), "already in use?)\n")
+ cat("Solve the problem, then type: require(svGUI)\n")
+ } else {
+ # Finally, load svGUI
+ res[3] <- require(svGUI, quietly = TRUE)
+
+ if (all(res)) {
+ cat("R is SciViews ready!\n")
+ .SciViewsReady <- TRUE
+ if (is.null(getOption("ko.id"))) options(ko.id = "R") # Default
+ # Do we (re)activate Komodo now?
+ koact <- getOption("ko.activate")
+ if (is.null(koact)) koact <- FALSE
+ if (koact[1]) {
+ if ((.Platform$pkgType == "mac.binary")) {
+ Res <- system("osascript -e 'tell application \"Komodo\" to activate'",
+ intern = TRUE)
+ rm(Res)
+ } ### TODO: the same under Windows and Linux
+ # Indicate to Komodo that R is ready
+ koCmd('ko.statusBar.AddMessage("<<<data>>>", "R", 10000, true);',
+ data = paste("'", getOption("ko.id"), "' (R ", R.Version()$major, ".",
+ R.Version()$minor, ") connected", sep = ""))
+ }
+ rm(koact)
+ } else {
+ cat("R is not SciViews ready, install latest svMisc, svSocket & svGUI packages\n")
+ }
+ }
+ }
+ }
+
+ # Clean up .GlobalEnv
+ rm(minVersion, res)
+}
+
+### SciViews install end ###
\ No newline at end of file
Added: komodo/SciViews-K/SciViews-K.kpf
===================================================================
--- komodo/SciViews-K/SciViews-K.kpf (rev 0)
+++ komodo/SciViews-K/SciViews-K.kpf 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,283 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- Komodo Project File - DO NOT EDIT -->
+<project id="6200c0ed-45ec-4f46-a159-284803d65c04" kpf_version="4" name="SciViews-K.kpf">
+<folder id="f5feb14c-33f6-a44d-ad41-ab38bf630926" idref="6200c0ed-45ec-4f46-a159-284803d65c04" name="Project">
+</folder>
+<macro async="0" icon="chrome://famfamfamsilk/skin/icons/wrench.png" id="08af6b57-9cc0-4848-9775-1bbecb5ab2c0" idref="f5feb14c-33f6-a44d-ad41-ab38bf630926" keyboard_shortcut="" language="JavaScript" name="Configure" rank="100" trigger="trigger_postopen" trigger_enabled="0">
+try {
+
+var libPart = ko.projects.findPart('macro', 'extension_lib', 'container');
+eval(libPart.value);
+
+var koExt = new extensionLib();
+
+var project = ko.macros.current.project;
+
+var setupWin = project.getChildByAttributeValue('name','setup.xul', 1);
+var rdf = project.getChildByAttributeValue('name','install.rdf', 1);
+var data = {};
+
+var prefset = project.prefset;
+
+if(prefset.hasPrefHere('configured')) {
+ var rdf_xml = koExt.readFile(rdf.getFile().URI);
+ data = {
+ 'valid': false,
+ 'configured': true,
+ 'vars': koExt.getRdfVars(rdf_xml)
+ };
+ data.vars['ext_name'] = koExt.getNiceName(data.vars.name);
+} else { // init data
+ data = {
+ 'valid': false,
+ 'configured': false,
+ 'vars': {
+ 'id': '',
+ 'name': 'My Extension',
+ 'creator': 'Me',
+ 'version': '0.1',
+ 'description': '',
+ 'homepageURL': '',
+ 'ext_name': ''
+ }
+ };
+}
+
+window.openDialog(
+ setupWin.getFile().URI,
+ "_blank",
+ "centerscreen,chrome,resizable,scrollbars,dialog=no,close,modal=yes",
+ data
+);
+
+if(data.valid) {
+ if(koExt.updateProject(data.vars)) {
+ prefset.setBooleanPref('configured', true);
+ var part = project.getChildByAttributeValue('name', 'oncreate',1);
+ if(part) { part.name = 'Configure'; }
+ var msg = 'Extension Project '+data.vars.name+' configured!';
+ ko.statusBar.AddMessage(msg, 'project', 3000, true);
+ ko.projects.manager.saveProject(project);
+ } else {
+ alert('Error encountered: '+koExt.error+"\nConfiguration aborted.");
+ }
+}
+
+} catch(e) {
+ alert(e);
+}
+</macro>
+<macro async="0" icon="chrome://famfamfamsilk/skin/icons/brick.png" id="1ea22b28-e1b5-a44d-a3e2-40e33f456acf" idref="f5feb14c-33f6-a44d-ad41-ab38bf630926" keyboard_shortcut="" language="JavaScript" name="extension_lib" rank="100" trigger="trigger_postopen" trigger_enabled="0">
+try {
+
+var extensionLib = function() {
+ this.os = Components.classes['@activestate.com/koOs;1'].
+ getService(Components.interfaces.koIOs);
+ this.error = false;
+}
+
+extensionLib.prototype.getPath = function(relative) {
+ try {
+ var prj_path = ko.interpolate.interpolateStrings('%p');
+ path = this.os.path.join(prj_path, relative);
+ return path;
+ } catch(e) {
+ alert(e+"\narg name: "+name);
+ }
+}
+
+extensionLib.prototype.readFile = function(filename) {
+ // read the template file
+ try {
+ var fileEx = Components.classes["@activestate.com/koFileEx;1"]
+ .createInstance(Components.interfaces.koIFileEx);
+ fileEx.URI = filename;
+ fileEx.open('rb');
+ var content = fileEx.readfile();
+ fileEx.close();
+ return content;
+ } catch(e) {
+ alert(e+"\narg filename: "+filename);
+ }
+}
+
+extensionLib.prototype.writeFile = function(filename, content) {
+ try {
+ var fileEx = Components.classes["@activestate.com/koFileEx;1"]
+ .createInstance(Components.interfaces.koIFileEx);
+ fileEx.URI = filename;
+ fileEx.open('wb+');
+ fileEx.puts(content);
+ fileEx.close();
+ } catch(e) {
+ alert(e+"\narg filename: "+filename);
+ }
+}
+
+extensionLib.prototype.getRdfVars = function(txt) {
+ try {
+ var Rx = /\<em\:([\w]+)[\ \S]*\>([\S\ ]+?)\<\//g;
+ var ext_vars = {};
+ while(results = Rx.exec(txt)) {
+ var idRx = /type|min|max|\{/;
+ if(!idRx.test(results[0])) { // filter out stuff we don't want
+ ext_vars[results[1]] = results[2];
+ }
+ }
+ return ext_vars;
+ } catch(e) {
+ alert(e+"\narg rdf_path: "+rdf_path);
+ }
+}
+
+extensionLib.prototype.getManifestVars = function(txt) {
+ try {
+ var rx1 = /content ([\S]+?) jar\:([\S]+?)\.jar/g;
+ var res1 = rx1.exec(txt);
+ var rx2 = /chrome:\/\/([\S]+?)\/content\/overlay\.xul/g;
+ var res2 = rx2.exec(txt);
+ return new Array(res1[1], res1[2], res2[1]);
+ } catch(e) {
+ alert(e+"\narg path: "+path);
+ }
+}
+
+extensionLib.prototype.getOverlayVars = function(txt) {
+ try {
+ var rx1 = /<overlay id="([\S]+?)"/g;
+ var res1 = rx1.exec(txt);
+ var rx2 = /<menuitem id="([\S]+?)"[\s]+?label="([\S\ ]+?)"/g;
+ var res2 = rx2.exec(txt);
+ return [res1[1], res2[1], res2[2]];
+ } catch(e) {
+ alert(e+"\narg path: "+path);
+ }
+}
+
+extensionLib.prototype.updateProject = function(vars) {
+ try {
+ var overlayPath = this.getPath('content/overlay.xul');
+ if(this.os.path.exists(overlayPath)) {
+ var ovl_str = this.readFile(overlayPath);
+ var ov_vars = this.getOverlayVars(ovl_str);
+ var ovl_new = [vars.ext_name+'Overlay', 'menu_'+vars.ext_name, vars.name];
+ this.writeFile(overlayPath, this.replaceAll(ov_vars, ovl_new, ovl_str));
+ } else { this.error = "Doesn't exist: "+overlayPath; return false; }
+
+ var manifestPath = this.getPath('chrome.manifest');
+ if(this.os.path.exists(manifestPath)) {
+ var man_str = this.readFile(manifestPath);
+ var man_vars = this.getManifestVars(man_str);
+ var man_new = [vars.ext_name, vars.ext_name, vars.ext_name];
+ this.writeFile(manifestPath, this.replaceAll(man_vars, man_new, man_str));
+ } else { this.error = "Doesn't exist: "+overlayPath; return false; }
+
+ var rdf_path = this.getPath('install.rdf');
+ if(this.os.path.exists(rdf_path)) {
+ var rdf_str = this.readFile(rdf_path);
+ var rdf_vars = this.getRdfVars(rdf_str);
+ this.writeFile(rdf_path, this.replaceAll(rdf_vars, vars, rdf_str));
+ } else { this.error = "Doesn't exist: "+overlayPath; return false; }
+
+ } catch(e) {
+ this.error = e;
+ return false;
+ }
+ return true;
+}
+
+extensionLib.prototype.replaceAll = function(orig_vars, new_vars, str) {
+ try {
+ var out = str;
+ for(v in orig_vars) {
+ out = out.replace(orig_vars[v], new_vars[v]);
+ }
+ return out;
+ } catch(e) {
+ alert(e);
+ }
+}
+
+extensionLib.prototype.getNiceName = function(name) {
+ return this.trim(name).replace(/[\W]/g,'').toLowerCase();
+}
+
+extensionLib.prototype.trim = function(str) {
+ return str.replace(/^\s*/, '').replace(/\s*$/, '');
+}
+
+extensionLib.prototype.clone = function(obj) {
+ var newobj = {}; for(i in obj) {
+ newobj[i] = obj[i];
+ } return newobj;
+}
+
+extensionLib.prototype._dump = function(obj) {
+ var str = ''; for(i in obj) {
+ str += i+': '+obj[i]+'\n';
+ } return(str);
+}
+
+extensionLib.prototype._keys = function(obj) {
+ var out = new Array(); for(i in obj) {
+ out.push(i);
+ } return out;
+}
+
+} catch(e) {
+ allert(e);
+}
+</macro>
+<macro async="0" icon="chrome://famfamfamsilk/skin/icons/lightning_go.png" id="41904da6-0dd6-d747-8a6c-a2663e10578b" idref="f5feb14c-33f6-a44d-ad41-ab38bf630926" keyboard_shortcut="" language="JavaScript" name="Build" rank="100" trigger="trigger_postopen" trigger_enabled="0">
+/**
+ * Script to build an xpi, running koext build in the current project root.
+ */
+
+var project = ko.macros.current.project;
+
+var os = Components.classes['@activestate.com/koOs;1'].
+ getService(Components.interfaces.koIOs);
+
+var koSysUtils = Components.classes["@activestate.com/koSysUtils;1"].
+ getService(Components.interfaces.koISysUtils);
+
+var appInfo = Components.classes["@mozilla.org/xre/app-info;1"].
+ getService(Components.interfaces.nsIXULRuntime);
+
+var koDirs = Components.classes['@activestate.com/koDirs;1'].
+ getService(Components.interfaces.koIDirs);
+
+var pythonExe = koDirs.pythonExe;
+var projectDir = ko.interpolate.interpolateStrings('%p');
+var scriptName = 'koext';
+
+if (appInfo.OS == 'WINNT') {
+ scriptName += ".py";
+}
+
+var arr = [koDirs.sdkDir, 'bin', scriptName]
+var app = os.path.joinlist(arr.length, arr);
+var cmd = '"'+pythonExe+'" "'+app+'" build -d "'+projectDir+'"';
+
+if (appInfo.OS == 'WINNT') {
+ cmd = '"' + cmd + '"';
+}
+var cwd = koDirs.mozBinDir;
+cmd += " {'cwd': u'"+cwd+"'}";
+
+ko.run.runEncodedCommand(window, cmd, function() {
+ ko.statusBar.AddMessage('Build complete', 'projects', 5000, true);
+ ko.projects.manager.saveProject(project);
+});
+</macro>
+<file id="ce09e80e-4f8e-784c-81c1-6564f46e2cf8" idref="f5feb14c-33f6-a44d-ad41-ab38bf630926" name="setup.xul" url="_prj_internal_/setup.xul">
+</file>
+<preference-set idref="6200c0ed-45ec-4f46-a159-284803d65c04">
+ <boolean id="configured">1</boolean>
+ <string id="import_exclude_matches">*.*~;*.bak;*.tmp;CVS;.#*;*.pyo;*.pyc;.svn;*%*;tmp*.html;.DS_Store;_prj_internal_</string>
+ <string id="import_include_matches"></string>
+ <boolean id="import_live">1</boolean>
+ <boolean id="import_recursive">1</boolean>
+ <string id="import_type">useFolders</string>
+</preference-set>
+</project>
Added: komodo/SciViews-K/_prj_internal_/setup.xul
===================================================================
--- komodo/SciViews-K/_prj_internal_/setup.xul (rev 0)
+++ komodo/SciViews-K/_prj_internal_/setup.xul 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,171 @@
+<?xml version="1.0"?>
+<?xml-stylesheet href="chrome://global/skin/" type="text/css"?>
+<?xml-stylesheet href="chrome://komodo/skin/" type="text/css"?>
+
+<dialog
+ id="test"
+ title="Komodo Extension configuration"
+ xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul"
+ onload="setup()"
+ width="400px"
+ height="480px"
+ buttons="accept,cancel"
+ buttonlabelcancel="Cancel"
+ buttonlabelaccept="Save"
+ ondialogaccept="return teardown();"
+ ondialogcancel="return cancel();"
+ defaultButton="accept"
+ buttonalign="horizontal"
+ buttonorient="horizontal"
+ orient="vertical"
+ >
+
+<script type="application/x-javascript">
+<![CDATA[
+
+var data = {};
+var ext_name = '';
+
+function get_id(strId) { return document.getElementById(strId); }
+function get_val(strId) { return get_id(strId).value; }
+function set_val(strId, val) { get_id(strId).value = val; }
+function get_nice_name(name) { return trim(name).replace(/[\W]/g,'').toLowerCase(); }
+// Added by PhG to allow uppercases in web site name
+function get_nice_name2(name) { return trim(name).replace(/[\W]/g,''); }
+
+function trim(str) { return str.replace(/^\s*/, '').replace(/\s*$/, ''); }
+function _dump(obj) {
+ try{
+ var str = ''; for(i in obj) {
+ str += i+': '+obj[i]+'\n';
+ }
+ } catch(e) {alert(e);}
+ return str;
+}
+
+function setup() {
+ try {
+ if(typeof(window.arguments) == 'undefined') {
+ alert('Error: No Window arguments?');
+ } else {
+ data = window.arguments[0];
+ var vars = data.vars;
+ for(i in vars) {
+ if(i == 'id' || i == 'ext_name') {
+ //pass
+ } else {
+ set_val(i, vars[i]);
+ }
+ }
+ if(vars['id']) {
+ var arr = vars.id.split('@');
+ if(arr.length < 2) {
+ alert('Extension Id is not in the correct format?');
+ return;
+ }
+ set_val('author-domain', arr[1]);
+ }
+ update_id();
+ if(!data.vars['homepageUrl']) {
+ update_url();
+ }
+ }
+ } catch(e) { alert(e); }
+}
+
+function update_url() {
+ var domain = get_id('author-domain').value;
+ //var ext_name = get_nice_name(get_val('name'));
+ var ext_name = get_nice_name2(get_val('name'));
+ set_val('homepageURL', 'http://'+domain+'/'+ext_name);
+}
+
+function update_id() {
+ try {
+ var name = get_val('name');
+ data.vars.ext_name = get_nice_name(name);
+
+ var domain = get_id('author-domain').value;
+ var newId = data.vars.ext_name+'@'+domain;
+
+ get_id('id').value = newId;
+ } catch(e) {
+ alert(e);
+ }
+}
+
+function teardown() {
+ try {
+ for(i in data.vars) {
+ if(i != 'ext_name') {
+ data.vars[i] = get_val(i);
+ }
+ }
+ data.vars.ext_name = get_nice_name(data.vars.name);
+ data.valid = true;
+ data.configured = true;
+ window.close();
+ } catch(e) {
+ alert(e);
+ }
+}
+
+function cancel() {
+ return confirm('Cancel Configuration?');
+}
+
+function keys(obj) {
+ var out = new Array(); for(i in obj) {
+ out.push(i);
+ } return out;
+}
+
+]]>
+</script>
+
+
+<commandset id="koext_commands">
+ <command id="update_id" oncommand="update_id();"/>
+</commandset>
+
+<vbox flex="1">
+ <caption label="Extension Options"/>
+ <grid flex="1">
+ <columns>
+ <column/>
+ <column flex="1"/>
+ </columns>
+ <rows>
+ <row align="center">
+ <label value="Name:"/>
+ <textbox id="name" type="timed" timeout="1000" command="update_id"/>
+ </row>
+ <row align="center">
+ <label value="Version:"/>
+ <textbox id="version"/>
+ </row>
+ <row align="top">
+ <label value="Description:"/>
+ <textbox id="description" multiline="true" value=""/>
+ </row>
+ <row align="center">
+ <label value="Author:"/>
+ <textbox id="creator" value=""/>
+ </row>
+ <row align="center">
+ <label value="Domain:"/>
+ <textbox id="author-domain" value="yourdomain.org" type="timed" timeout="1000" command="update_id"/>
+ </row>
+ <row align="center">
+ <label value="Home Page:"/>
+ <textbox id="homepageURL" value=""/>
+ </row>
+ <row align="center">
+ <label value="Extension Id:"/>
+ <label style="font-weight: bolder;" id="id"/>
+ </row>
+ </rows>
+ </grid>
+</vbox>
+
+</dialog>
Added: komodo/SciViews-K/chrome.manifest
===================================================================
--- komodo/SciViews-K/chrome.manifest (rev 0)
+++ komodo/SciViews-K/chrome.manifest 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,7 @@
+content sciviewsk jar:sciviewsk.jar!/content/ xpcnativewrappers=yes
+overlay chrome://komodo/content/komodo.xul chrome://sciviewsk/content/overlay.xul
+
+locale sciviewsk en-GB jar:sciviewsk.jar!/locale/en-GB/
+locale sciviewsk fr-FR jar:sciviewsk.jar!/locale/fr-FR/
+
+skin sciviewsk classic/1.0 jar:sciviewsk.jar!/skin/
\ No newline at end of file
Added: komodo/SciViews-K/content/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/content/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/content/js/prefs.js
===================================================================
--- komodo/SciViews-K/content/js/prefs.js (rev 0)
+++ komodo/SciViews-K/content/js/prefs.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,15 @@
+// SciViews-K functions
+// Define default preferences values for SciViews-K
+// Copyright (c) 2008, Ph. Grosjean (phgrosjean at sciviews.org)
+
+// Define default socket ports for the client and server, and other parameters
+sv.prefs.setString("sciviews.server.socket", "7052", false);
+sv.prefs.setString("sciviews.client.socket", "8888", false);
+sv.prefs.setString("sciviews.client.id", "SciViewsK", false);
+
+// Where do we want to display R help? In internal browser or not?
+sv.prefs.setString("sciviews.r.help", "internal", false);
+
+// This is the base path for the R Wiki context help feature of sv.helpContext()
+sv.prefs.setString("sciviews.rwiki.help.base",
+ "http:/wiki.r-project.org/rwiki/doku.php?id=", false);
Added: komodo/SciViews-K/content/js/r.js
===================================================================
--- komodo/SciViews-K/content/js/r.js (rev 0)
+++ komodo/SciViews-K/content/js/r.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,719 @@
+// SciViews-K R functions
+// Define functions to command R from Komodo Edit
+// Copyright (c) 2008, Ph. Grosjean (phgrosjean at sciviews.org)
+
+////////////////////////////////////////////////////////////////////////////////
+// To cope with versions incompatibilities, we define this:
+// alert(sv.r.RMinVersion); // Display minimum R version required
+//
+// These functions are available if you trigger this macro on startup
+// Then, you can use them in other macros, menus, toolbars, ...
+// sv.r.eval(cmd); // Evaluate 'cmd' in R
+// sv.r.evalHidden(cmd, earlyExit); // Evaluate 'cmd' in R in a hidden way
+// sv.r.evalCallback(cmd, procfun); // Evaluate 'cmd' in R and call 'procfun'
+// sv.r.escape(); // Escape R calculation or multiline mode
+// sv.r.setwd(); // Set the working dir (choose or set to current buffer)
+// sv.r.run(); // Run current selection or line in R and goto next line
+// sv.r.runEnter(); // Run current line to pos in R and add a line feed
+// sv.r.source(what); // Source various part of current buffer to R
+// sv.r.send(what); // Send various part of current buffer to R
+// sv.r.display(topic, what); // Display 'topic' according to 'what' type
+// sv.r.helpStart(); // Start R help in the default browser
+// sv.r.help(topic); // Get help in R for 'topic', 'topic' is facultative
+// sv.r.example(topic); // Run example in R for 'topic' (facultative)
+// sv.r.search(topic); // Search R help for 'topic'
+// sv.r.search_select(topics); // Callback function: display a list of
+ // choices to select help page from
+// sv.r.siteSearch(topic); // Search R web sites for 'topic'
+// sv.r.dataList(loaded); // List R datasets in "loaded" or "all" packages
+// sv.r.data(); // Select one dataset to load
+// sv.r.data_select(data); // Callback function for sv.r.data()
+//
+// sv.r.pck namespace: /////////////////////////////////////////////////////////
+// sv.r.pkg.repositories(); // Select repositories for installing R packages
+// sv.r.pkg.CRANmirror(); // Select preferred CRAN mirror
+// sv.r.pkg.available(); // List available R packages on selected repositories
+// sv.r.pkg.installed(); // List installed R packages
+// sv.r.pkg.install(); // Install one R package from the repositories
+// sv.r.pkg.install_select(pkgs); // Callback function for sv.r.pkg.install()
+// sv.r.pkg.installDef(); // Call the default package installation routine of R
+// sv.r.pkg.installLocal(); // Install one or more R packages from local files
+// sv.r.pkg.installSV(); // Install the Sciviews bundle from CRAN
+// sv.r.pkg.installSVrforge(); // Install development versions of SciViews
+ // from R-Forge
+// sv.r.pkg.new(); // List new R packages available on CRAN
+// sv.r.pkg.old(); // List older installed R packages than distributed versions
+// sv.r.pkg.update(); // Update installed R packages from the repositories
+// sv.r.pkg.status(); // Show status of installed R packages
+// sv.r.pkg.loaded(); // Show which R packages are loaded
+// sv.r.pkg.load(); // Load one R package
+// sv.r.pkg.load_select(pkgs); // Callback function for sv.r.pkg.load()
+// sv.r.pkg.unload(); // Unload one r package
+// sv.r.pkg.unload_select(pkgs); // Callback function for sv.r.pkg.unload()
+// sv.r.pkg.remove(); // Remove one R package
+// sv.r.pkg.remove_select(pkgs); // Callback function for sv.r.pkg.remove()
+////////////////////////////////////////////////////////////////////////////////
+
+// Define the 'sv.r' namespace
+if (typeof(sv.r) == 'undefined') sv.r = { RMinVersion: "2.7.0" };
+
+// Evaluate code in R
+sv.r.eval = function(cmd) {
+ // Store the current R command
+ if (sv.socket.prompt == ":> ") {
+ // This is a new command
+ sv.socket.cmd = cmd;
+ } else {
+ // We continue previous multiline command
+ sv.socket.cmd += '\n' + cmd;
+ }
+ if (sv.socket.cmdout) {
+ if (sv.socket.prompt == ":> ") {
+ sv.cmdout.clear();
+ sv.cmdout.append(":> " + cmd);
+ } else {
+ sv.cmdout.append(cmd);
+ }
+ }
+ var res = sv.socket.rCommand('<<<e>>>' + cmd, sv.socket.cmdout);
+ return(res);
+}
+
+// Evaluate code in R in a hidden way
+sv.r.evalHidden = function(cmd, earlyExit) {
+ var preCode = "<<<h>>>";
+ if (earlyExit) preCode = "<<<H>>>";
+ // Evaluate a command in hidden mode (contextual help, calltip, etc.)
+ var res = sv.socket.rCommand(preCode + cmd, false);
+ return(res);
+}
+// Tests:
+//sv.r.evalHidden("Sys.sleep(5); cat('done\n')");
+//sv.r.evalHidden("Sys.sleep(5); cat('done\n')", earlyExit = true);
+//sv.r.evalHidden("Sys.sleep(3); cat('done\n');" +
+// " koCmd('alert(\"koCmd is back\");')", earlyExit = true);
+
+// Evaluate R expression and call procfun in Komodo with the result as argument
+sv.r.evalCallback = function(cmd, procfun) {
+ // Evaluate a command in hidden mode (contextual help, calltip, etc.)
+ // and call 'procfun' at the end of the evaluation
+ var res = sv.socket.rCommand("<<<h>>>" + cmd, false, null, procfun);
+ return(res);
+}
+
+// Escape R calculation
+sv.r.escape = function() {
+ // Send an <<<esc>>> sequence that breaks multiline mode
+ sv.socket.cmd = "";
+ sv.socket.prompt == ":> ";
+ if (sv.socket.cmdout) { sv.cmdout.clear(); }
+ var listener = { finished: function(data) {} }
+ var res = sv.socket.rCommand('<<<esc>>>', false);
+ return(res);
+}
+
+// Set the current working directory (to current buffer dir, or ask for it)
+sv.r.setwd = function(ask) {
+ var res = false;
+ if (ask == null) {
+ // Set R working directory to current buffer path
+ var kv = ko.views.manager.currentView;
+ if (!kv) return; // No current view, do nothing!
+ kv.setFocus();
+ if(kv.document.isUntitled) {
+ alert("File is not saved yet. Unable to get its directory!");
+ } else {
+ // Make sure path name is in Unix convention under Windows
+ res = sv.r.eval('.odir <- setwd("' +
+ kv.document.file.dirName.replace(/\\/g, "//") + '")');
+ }
+ } else if (ask == "previous") {
+ // Produce an error in R if .odir is not defined, but it is fine!
+ res = sv.r.eval('if (exists(".odir")) .odir <- setwd(.odir); getwd()');
+ } else {
+ // TODO: a graphical setwd()
+ alert("Graphical selection of R working dir... not implemented yet!");
+ }
+ return(res);
+}
+
+// Run current selection or line buffer in R
+sv.r.run = function() {
+ try {
+ var kv = ko.views.manager.currentView;
+ if (!kv) return; // No current view, do nothing!
+ kv.setFocus();
+ var ke = kv.scimoz;
+ var currentLine = ke.lineFromPosition(ke.currentPos);
+ if (ke.selText == "") {
+ ke.home();
+ ke.lineEndExtend();
+ // while ke.selText contains no code, look for next line
+ while (ke.selText.replace(/^\s*$/, "") == "") {
+ //Are we at the last line?
+ currentLine = ke.lineFromPosition(ke.currentPos);
+ if( currentLine == ( ke.lineCount - 1 ) ) { return; }
+ // Select next line
+ ke.lineDown();
+ ke.home();
+ ke.lineEndExtend();
+ }
+ }
+ var res = sv.r.eval(ke.selText);
+ ke.lineDown();
+ ke.homeDisplay();
+ } catch(e) { return(e); }
+ return(res);
+}
+
+// Run current line up to position and add line feed
+sv.r.runEnter = function() {
+ try {
+ var res = false;
+ var kv = ko.views.manager.currentView;
+ if (!kv) return; // No current view, do nothing!
+ kv.setFocus();
+ var ke = kv.scimoz;
+ if (ke.selText == "") { // Only proceed if selection is empty
+ var pos = ke.currentPos;
+ ke.homeExtend();
+ if (ke.selText != "") res = sv.r.eval(ke.selText);
+ // Add a line feed at pos
+ ke.gotoPos(pos);
+ ke.newLine();
+ }
+ } catch(e) { return(e); }
+ return(res);
+}
+
+// Source the whole content of the current buffer
+sv.r.source = function(what) {
+ var res = false;
+ try {
+ var kv = ko.views.manager.currentView;
+ if (!kv) return; // No current view, do nothing!
+ kv.setFocus();
+ var ke = kv.scimoz;
+ if (what == null) what = "all"; // Default value
+ // Special case: if "all", then, try sourcing the original file directly
+ // (if saved, or ask to save it)
+ if (what == "all") {
+ // Is this file saved?
+ if (kv.document.isUntitled) {
+ var answer = ko.dialogs.okCancel("File has not been saved" +
+ " yet. Would you like to save it now?", "OK");
+ if (answer == "OK") {
+ ko.commands.doCommand('cmd_save');
+ // Check if it saved now
+ if (!kv.document.isDirty) {
+ // Source it (make sure its name is in Unix convention
+ // under Windows)
+ res = sv.r.eval('source("' +
+ kv.document.file.path.replace(/\\/g, "//") + '")');
+ ko.statusBar.AddMessage("Document sourced in R...",
+ "R", 5000, true);
+ }
+ }
+ } else if (kv.document.isDirty) { // Are last changes saved?
+ var answer = ko.dialogs.okCancel("Changes have not been saved" +
+ " yet. Would you like to save now?", "OK");
+ if (answer == "OK") {
+ ko.commands.doCommand('cmd_save');
+ // Check if it saved now
+ if (!kv.document.isDirty) {
+ // Source it (make sure its name is in Unix convention
+ // under Windows)
+ res = sv.r.eval('source("' +
+ kv.document.file.path.replace(/\\/g, "//") + '")');
+ ko.statusBar.AddMessage("Document sourced in R...",
+ "R", 5000, true);
+ }
+ }
+ } else {
+ // The document is saved => proceed with sourcing it
+ // (make sure its name is in Unix convention under Windows)
+ res = sv.r.eval('source("' +
+ kv.document.file.path.replace(/\\/g, "//") + '")');
+ ko.statusBar.AddMessage("Document sourced in R...",
+ "R", 5000, true);
+ }
+ }
+ // We will make a copy of the selected code in a temp file
+ // and source it in R
+ var code = sv.getPart(what, what != "all", true); // Copy to clipboard
+ res = sv.r.eval('clipsource()');
+ // If not selected all, para or block, then, change position
+ if (what != "all" & what != "para" & what != "block") {
+ var kv = ko.views.manager.currentView;
+ kv.setFocus();
+ var ke = kv.scimoz;
+ ke.lineDown();
+ ke.homeDisplay();
+ }
+ } catch(e) { return(e); }
+ return(res);
+}
+
+// Send whole or a part of the current buffer to R, place cursor at next line
+sv.r.send = function(what) {
+ try {
+ if (what == null) what = "all"; // Default value
+ var code = sv.getPart(what, what != "all"); // Change sel if not 'all'
+ var res = sv.r.eval(code);
+ // If not selected all, para or block, then, change position
+ if (what != "all" & what != "para" & what != "block") {
+ var kv = ko.views.manager.currentView;
+ kv.setFocus();
+ var ke = kv.scimoz;
+ ke.lineDown();
+ ke.homeDisplay();
+ }
+ } catch(e) { return(e); }
+ return(res);
+}
+
+// Display R objects in different ways
+// TODO: allow custom methods + arguments + forcevisible + affect to var
+sv.r.display = function(topic, what) {
+ var res = false;
+ if (typeof(topic) == "undefined" | topic == "") topic = sv.getText();
+ if (topic == "") {
+ alert("Nothing is selected!");
+ } else {
+ // Display data in different ways, depending on what
+ switch(what) {
+ case "names":
+ res = sv.r.eval("names(" + topic + ")");
+ break;
+ case "structure":
+ res = sv.r.eval("str(" + topic + ")");
+ break;
+ case "summary":
+ res = sv.r.eval("summary(" + topic + ")");
+ break;
+ case "plot":
+ res = sv.r.eval("plot(" + topic + ")");
+ break;
+ case "content":
+ case "print":
+ case "show":
+ default:
+ res = sv.r.eval(topic);
+ }
+ }
+ return(res);
+}
+
+// Start R help in the default browser
+sv.r.helpStart = function() {
+ var res = sv.r.eval("help.start()");
+ ko.statusBar.AddMessage("R help started... should display in browser soon",
+ "R", 5000, true);
+ return(res);
+}
+
+// Get help in R (HTML format)
+sv.r.help = function(topic) {
+ var res = false;
+ if (typeof(topic) == "undefined" | topic == "") topic = sv.getText();
+ if (topic == "") {
+ alert("Nothing is selected!");
+ } else {
+ res = sv.r.evalCallback('cat(unclass(help("' + topic +
+ '", htmlhelp = TRUE)))', sv.browseURI);
+ ko.statusBar.AddMessage("R help asked for '" + topic + "'",
+ "R", 5000, true);
+ }
+ return(res);
+}
+
+// Run the example for selected item
+sv.r.example = function(topic) {
+ var res = false;
+ if (typeof(topic) == "undefined" | topic == "") topic = sv.getText();
+ if (topic == "") {
+ alert("Nothing is selected!");
+ } else {
+ res = sv.r.eval("example(" + topic + ")");
+ ko.statusBar.AddMessage("R example run for '" + topic + "'",
+ "R", 5000, true);
+ }
+ return(res);
+}
+
+// Search R help for topic
+sv.r.search = function(topic, internal) {
+ var res = false;
+ if (typeof(topic) == "undefined" | topic == "") topic = sv.getText();
+ // Ask for the search string
+ topic = ko.dialogs.prompt("Search R objects using a regular expression" +
+ " (e.g., '^log' for objects starting with 'log')",
+ "Pattern", topic, "Search R help", "okRsearchPattern");
+ if (topic != null & topic != "") {
+ // Get list of matching items and evaluate it with sv.r.search_select()
+ res = sv.r.evalCallback('cat(apropos("' + topic + '"), sep = "\n")',
+ sv.r.search_select);
+ ko.statusBar.AddMessage("Searching R help for '" + topic + "'",
+ "R", 5000, true);
+ }
+ return(res);
+}
+
+// The callback for sv.r.search
+sv.r.search_select = function(topics) {
+ ko.statusBar.AddMessage("", "R");
+ var res = false;
+ if (sv.tools.strings.removeLastCRLF(topics) == "") {
+ alert("No item found in R help!");
+ } else { // Something is returned
+ var items = topics.split("\n");
+ if (items.length == 1) {
+ // Only one item, show help for it
+ res = sv.r.help(sv.tools.strings.removeLastCRLF(topics));
+ } else {
+ // Select the item you want in the list
+ var topic = ko.dialogs.selectFromList("R help",
+ "Select a topic:", items, "one");
+ if (topic != null)
+ res = sv.r.help(sv.tools.strings.removeLastCRLF(topic.join("")));
+ }
+ }
+ return(res);
+}
+
+
+// Search R web sites for topic
+sv.r.siteSearch = function(topic) {
+ var res = false;
+ if (typeof(topic) == "undefined" | topic == "") topic = sv.getText();
+ if (topic == "") {
+ alert("Nothing is selected!");
+ } else {
+ res = sv.r.evalHidden('RSiteSearch("' + topic + '")', earlyExit = true);
+ ko.statusBar.AddMessage("R site search asked for '" + topic + "'",
+ "R", 5000, true);
+ }
+ return(res);
+}
+
+// List available datasets ("loaded" or not defined = loaded packages, or "all")
+sv.r.dataList = function(which) {
+ var res = false;
+ if (typeof(which) == "undefined" | which == "" | which == "loaded") {
+ var res = sv.r.eval('data()');
+ } else { // which == "all"
+ var res = sv.r.eval('data(package = .packages(all.available = TRUE))');
+ }
+ return(res);
+}
+
+// Load one R dataset
+sv.r.data = function() {
+ var res = false;
+ // Get list of all datasets
+ res = sv.r.evalCallback('.tmp <- data();' +
+ 'cat(paste(.tmp$results[, "Item"], .tmp$results[, "Title"], sep = "\t - "), sep = "\n");' +
+ 'rm(.tmp)', sv.r.data_select);
+ ko.statusBar.AddMessage("Listing available R datasets... please wait",
+ "R", 20000, true);
+ return(res);
+}
+
+// The callback for sv.r.data
+sv.r.data_select = function(data) {
+ ko.statusBar.AddMessage("", "R");
+ var res = false;
+ if (sv.tools.strings.removeLastCRLF(data) == "") {
+ alert("Problem retrieving the list of R datasets!");
+ } else { // Something is returned
+ var items = data.split("\n");
+ // Select the item you want in the list
+ var item = ko.dialogs.selectFromList("R Datasets",
+ "Select one R dataset:", items, "one");
+ if (item != null) {
+ // We need to eliminate the definition
+ var dat = item[0].split("\t");
+ var datname = dat[0];
+ // Sometimes, we got 'item (data)' => retrieve 'data' in this case
+ datname = datname.replace(/^[a-zA-Z0-9._ ]*[(]/, "");
+ datname = datname.replace(/[)]$/, "");
+ res = sv.r.eval('data(' + datname + ')');
+ }
+ }
+ return(res);
+}
+
+
+// Define the 'sv.r.pkg' namespace /////////////////////////////////////////////
+if (typeof(sv.r.pkg) == 'undefined') sv.r.pkg = new Object();
+
+// List available packages on the selected repositories
+sv.r.pkg.available = function() {
+ var res = sv.r.eval('.pkgAvailable <- available.packages()\n' +
+ 'as.character(.pkgAvailable[, "Package"])');
+ ko.statusBar.AddMessage("Looking for available R packages... please wait",
+ "R", 5000, true);
+ return(res);
+}
+
+// List installed packages
+sv.r.pkg.installed = function() {
+ var res = sv.r.eval('.pkgInstalled <- installed.packages()\n' +
+ 'as.character(.pkgInstalled[, "Package"])');
+ ko.statusBar.AddMessage("Looking for installed R packages... please wait",
+ "R", 5000, true);
+ return(res);
+}
+
+// List new packages in the repositories
+sv.r.pkg.new = function() {
+ var res = sv.r.eval('(.pkgNew <- new.packages())');
+ ko.statusBar.AddMessage("Looking for new R packages... please wait",
+ "R", 5000, true);
+ return(res);
+}
+
+// List installed packages which are older than those in repositories (+ versions)
+sv.r.pkg.old = function() {
+ var res = sv.r.eval('.pkgOld <- old.packages()\n' +
+ 'noquote(.pkgOld[, c("Installed", "ReposVer")])');
+ ko.statusBar.AddMessage("Looking for old R packages... please wait",
+ "R", 5000, true);
+ return(res);
+}
+
+// Update installed packages
+sv.r.pkg.update = function() {
+ var res = sv.r.eval('update.packages(ask = "graphics")');
+ ko.statusBar.AddMessage("Updating R packages... please wait",
+ "R", 5000, true);
+ return(res);
+}
+
+// Some statistics about R packages
+sv.r.pkg.status = function() {
+ var res = sv.r.eval('(.pkgStatus <- packageStatus())');
+ ko.statusBar.AddMessage("Compiling R packages status... please wait",
+ "R", 5000, true);
+ return(res);
+}
+
+// Which R packages are currently loaded?
+sv.r.pkg.loaded = function() {
+ var res = sv.r.eval('(.packages())');
+ return(res);
+}
+
+// Load one R package
+sv.r.pkg.load = function() {
+ var res = false;
+ // Get list of installed R packages that are not loaded yet
+ res = sv.r.evalCallback('.tmp <- .packages(all.available = TRUE);' +
+ 'cat(.tmp[!.tmp %in% .packages()], sep = "\n"); rm(.tmp)',
+ sv.r.pkg.load_select);
+ ko.statusBar.AddMessage("Listing available R packages... please wait",
+ "R", 20000, true);
+ return(res);
+}
+
+// The callback for sv.r.pkg.load
+sv.r.pkg.load_select = function(pkgs) {
+ ko.statusBar.AddMessage("", "R");
+ var res = false;
+ if (sv.tools.strings.removeLastCRLF(pkgs) == "") {
+ alert("All installed R packages seem to be already loaded!");
+ } else { // Something is returned
+ var items = pkgs.split("\n");
+ // Select the item you want in the list
+ var topic = ko.dialogs.selectFromList("Load R package",
+ "Select one R package to load:", items, "one");
+ if (topic != null) {
+ res = sv.r.eval('library(' +
+ (sv.tools.strings.removeLastCRLF(topic.join(''))) + ')');
+ }
+ }
+ return(res);
+}
+
+// Unload one R package
+sv.r.pkg.unload = function() {
+ var res = false;
+ // Get list of loaded packages, minus required ones we cannot unload
+ res = sv.r.evalCallback('.tmp <- .packages();' +
+ 'cat(.tmp[!.tmp %in% c(.required, "base")], sep = "\n"); rm(.tmp)',
+ sv.r.pkg.unload_select);
+ ko.statusBar.AddMessage("Listing loaded R packages... please wait",
+ "R", 20000, true);
+ return(res);
+}
+
+// The callback for sv.r.pkg.unload
+sv.r.pkg.unload_select = function(pkgs) {
+ ko.statusBar.AddMessage("", "R");
+ var res = false;
+ if (sv.tools.strings.removeLastCRLF(pkgs) == "") {
+ alert("None of the loaded packages are safe to unload!");
+ } else { // Something is returned
+ var items = pkgs.split("\n");
+ // Select the item you want in the list
+ var topic = ko.dialogs.selectFromList("Unload R package",
+ "Select one R package to unload:", items, "one");
+ if (topic != null) {
+ res = sv.r.eval('detach("package:' +
+ (sv.tools.strings.removeLastCRLF(topic.join(''))) + '")');
+ }
+ }
+ return(res);
+}
+
+// Remove one R package
+sv.r.pkg.remove = function() {
+ var res = false;
+ // Get list of all packages, minus required and recommended ones we cannot remove
+ res = sv.r.evalCallback('.tmp <- installed.packages(); ' +
+ '.tmp <- rownames(.tmp)[is.na(.tmp[, "Priority"])]; ' +
+ 'cat(.tmp[!.tmp %in% c(.required, "svMisc", "svIDE", "svGUI", "svSocket", "svIO", "svViews", "svWidgets", "svDialogs")], sep = "\n"); rm(.tmp)',
+ sv.r.pkg.remove_select);
+ ko.statusBar.AddMessage("Listing removable R packages... please wait",
+ "R", 20000, true);
+ return(res);
+}
+
+// The callback for sv.r.pkg.remove
+sv.r.pkg.remove_select = function(pkgs) {
+ ko.statusBar.AddMessage("", "R");
+ var res = false;
+ if (sv.tools.strings.removeLastCRLF(pkgs) == "") {
+ alert("None of the installed R packages are safe to remove!");
+ } else { // Something is returned
+ var items = pkgs.split("\n");
+ // Select the item you want in the list
+ var topic = ko.dialogs.selectFromList("Remove R package",
+ "Select one R package to remove:", items, "one");
+ if (topic != null) {
+ var pkg = (sv.tools.strings.removeLastCRLF(topic.join('')));
+ var response = ko.dialogs.customButtons("You are about to remove the '" +
+ pkg + "' R package from disk! Are you sure?",
+ ["&Continue...", "Cancel"], // buttons
+ "Continue...", // default response
+ null, // text
+ "Removing an R package"); // title
+ if (response == "Cancel") { return res; }
+
+ res = sv.r.eval('remove.packages("' + pkg +
+ '", lib = installed.packages()["' + pkg + '", "LibPath"])');
+ }
+ }
+ return(res);
+}
+
+// Install one R package
+// TODO: allow installing more than one package at a time
+sv.r.pkg.install = function() {
+ var res = false;
+ // Get list of all packages, minus required and recommended ones we cannot remove
+ res = sv.r.evalCallback('cat(rownames(available.packages()), sep = "\n")',
+ sv.r.pkg.install_select);
+ ko.statusBar.AddMessage("Listing available R packages... please wait",
+ "R", 60000, true);
+ return(res);
+}
+
+// The callback for sv.r.pkg.install
+sv.r.pkg.install_select = function(pkgs) {
+ ko.statusBar.AddMessage("", "R");
+ var res = false;
+ if (sv.tools.strings.removeLastCRLF(pkgs) == "") {
+ alert("Don't find available R packages!");
+ } else { // Something is returned
+ var items = pkgs.split("\n");
+ // Select the item you want in the list
+ var topic = ko.dialogs.selectFromList("Install R package",
+ "Select one R package to install:", items, "one");
+ if (topic != null) {
+ var pkg = (sv.tools.strings.removeLastCRLF(topic.join('')));
+ res = sv.r.eval('install.packages("' + pkg + '")');
+ ko.statusBar.AddMessage("Install package and dependencies... please wait",
+ "R", 60000, true);
+ }
+ }
+ return(res);
+}
+
+// Select repositories
+// TODO: a Komodo version of this that returns pure R code
+sv.r.pkg.repositories = function() {
+ var res = sv.r.eval('setRepositories(TRUE)');
+ return(res);
+}
+
+// Select CRAN mirror
+// TODO: a Komodo version of this that returns pure R code
+sv.r.pkg.CRANmirror = function() {
+ var res = sv.r.eval('chooseCRANmirror(TRUE)');
+ return(res);
+}
+
+// Install packages (the default R version)
+// TODO: merge this with sv.r.pkg.install, but allow more than one package
+sv.r.pkg.installDef = function() {
+ var res = false;
+ res = sv.r.eval('install.packages()');
+ ko.statusBar.AddMessage("Listing available R packages... please wait",
+ "R", 5000, true);
+ return(res);
+}
+
+// Install R packages from local zip files
+// TODO: set filter for R package files!
+// TODO: use R CMD INSTALL instead + R CMD BUILD (--binary) + R CMD REMOVE
+sv.r.pkg.installLocal = function() {
+ var res = false;
+ // Get list of files to install
+ var files = ko.filepicker.openFiles(null, null,
+ "Select R package(s) to install (.tar.gz, .zip or .tgz)");
+ if (files != null) {
+ var cmd = "install.packages("
+ if (files.length == 1) {
+ cmd += '"' + files.join("") + '", repos = NULL)';
+ } else {
+ cmd += 'c("' + files.join('", "') + '", repos = NULL))';
+ }
+ res = sv.r.eval(cmd);
+ ko.statusBar.AddMessage("Installing R package(s)... please wait",
+ "R", 5000, true);
+ }
+ return(res);
+}
+
+// Install the SciViews bundle from CRAN
+sv.r.pkg.installSV = function() {
+ var res = false;
+ var response = ko.dialogs.customButtons("Currently, CRAN hosts an old, incompatible\n" +
+ "version of the SciViews-R bundle.\nInstall it anyway?",
+ ["&Continue...", "Cancel"], // buttons
+ "Continue...", // default response
+ null, // text
+ "Install the SciViews-R bundle from CRAN"); // title
+ if (response == "Cancel") { return res; }
+ res = sv.r.eval('install.packages("SciViews")');
+ ko.statusBar.AddMessage("Installing SciViews R bundle... please wait",
+ "R", 5000, true);
+ return(res);
+}
+
+// Install the latest development version of Sciviews packages from R-Forge
+sv.r.pkg.installSVrforge = function() {
+ var res = false;
+ var response = ko.dialogs.customButtons("R-Forge distributes latest development\n" +
+ "version of the SciViews-R bundle.\nThis is NOT the lastest stable one!\nInstall it anyway?",
+ ["&Continue...", "Cancel"], // buttons
+ "Continue...", // default response
+ null, // text
+ "Install the SciViews-R bundle from R-Forge"); // title
+ if (response == "Cancel") { return res; }
+ res = sv.r.eval('install.packages(c("svMisc", "svSocket", "svGUI", "svIDE"), repos = "http://R-Forge.R-project.org")');
+ ko.statusBar.AddMessage("Installing SciViews R packages from R-Forge... please wait",
+ "R", 5000, true);
+ return(res);
+}
Added: komodo/SciViews-K/content/js/robjects.js
===================================================================
--- komodo/SciViews-K/content/js/robjects.js (rev 0)
+++ komodo/SciViews-K/content/js/robjects.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,217 @@
+// SciViews-K R objects functions
+// Define the 'sv.r.objects' namespace
+// Copyright (c) 2008, Romain Francois
+// Contribution from Philippe Grosjean
+
+////////////////////////////////////////////////////////////////////////////////
+// objectList // List of objects to display
+// searchPaths // List of serach paths in R
+// searchPathsSelected // List of currently selected search paths
+//
+// sv.r.objects.searchpath(); // Show/hide the search path listbox
+// sv.r.objects.getPackageList(); // Query R for the search path
+// sv.r.objects._processPackageList(data); // Callback to process this list
+// sv.r.objects.displayPackageList(goback); // Display the search path items
+// sv.r.objects.addObjectList(pack); // Get list of objects from R
+// sv.r.objects._processObjectList(data); // Callback to process list of objects
+// sv.r.objects.displayObjectList(goback); // Display the objects in the tree
+// sv.r.objects.packageSelectedEvent(event); // Process click event in the list
+// sv.r.objects.packageSelected(pack, status); // Change package selection
+// sv.r.objects.__isSelected(p); // Is a package selected?
+// sv.r.objects.__addPackageToSelection(p); // Add a package to the list of sel
+// sv.r.objects.__removePackageFromSelection(p); // Remove a package from sel
+//
+////////////////////////////////////////////////////////////////////////////////
+//
+// TODO:
+// Autorefresh of R Objects from R + do not refresh if R Objects is not visible
+// Remember the selection in the path list persitently
+// Tooltips for objects
+// Context menu calculated from R
+// Drag&drop of objects to a buffer
+////////////////////////////////////////////////////////////////////////////////
+
+// Define the 'sv.r.objects' namespace
+if (typeof(sv.r.objects) == 'undefined')
+ sv.r.objects = {
+ objectList: [],
+ searchPaths: [],
+ searchPathsSelected: []
+ }
+
+// Show/hide the search path listbox
+sv.r.objects.searchpath = function() {
+ var split = document.getElementById("sciviews_robjects_splitter");
+ var state = split.getAttribute("state");
+ if (state == "collapsed") {
+ state = "open";
+ } else {
+ state = "collapsed";
+ }
+ split.setAttribute("state", state);
+}
+
+// Get the list of packages on the search path from R
+sv.r.objects.getPackageList = function() {
+ var cmd = 'cat(objSearch(sep = ",", compare = FALSE))';
+ sv.r.evalCallback(cmd, sv.r.objects._processPackageList);
+};
+
+// Callback to process the list of packages in the search path from R
+sv.r.objects._processPackageList = function(data) {
+ if (data == "") { return; } // No changes
+ sv.r.objects.searchPaths = data.replace(/[\n\r]/g, "").split(/,/);
+ sv.r.objects.displayPackageList();
+};
+
+// Display the list of packages in the search path
+sv.r.objects.displayPackageList = function(goback) {
+ var pack;
+ var node = document.getElementById("sciviews_robjects_searchpath_listbox");
+ sv.tools.e4x2dom.clear(node);
+
+ var item;
+ var packs = sv.r.objects.searchPaths;
+ var k = 0;
+ var checked = "false";
+ for(var i = 0; i < packs.length; i++) {
+ pack = packs[i]
+ if (sv.r.objects.__isSelected(pack)) {
+ ischecked = "true";
+ } else {
+ ischecked = "false";
+ }
+ item =
+ <listitem type="checkbox" label={pack} checked={ischecked}
+ onclick="sv.r.objects.packageSelectedEvent(event)"
+ spid={packs[i]}
+ />;
+ sv.tools.e4x2dom.append(item, node, k);
+ k++;
+ }
+ sv.r.objects.displayObjectList(false);
+ // if(goback) tb.focus();
+};
+
+// Ask R for the list of objects in an environment
+sv.r.objects.addObjectList = function(pack) {
+ var id = sv.prefs.getString("sciviews.client.id", "SciViewsK");
+ var cmd = 'cat(objList(id = "' + id + '_' + pack + '", envir = "' + pack +
+ '", all.info = TRUE, sep = ","), sep = "\n")';
+ sv.r.evalCallback(cmd, sv.r.objects._processObjectList);
+};
+
+// Callback to process the list of objects in an environment
+sv.r.objects._processObjectList = function(data) {
+ if (data == "") { return; } //no changes
+ lines = data.split("\n");
+ var rx = /,/;
+ var item, line;
+ var pack;
+ var idx;
+
+ for (var i = 0; i < lines.length; i++) {
+ if (rx.test(lines[i])) {
+ line = lines[i].split(",");
+ pack = line[0];
+
+ if (sv.r.objects.objectList[pack] == undefined) {
+ sv.r.objects.objectList[pack] = [];
+ idx = 0;
+ } else {
+ idx = sv.r.objects.objectList[pack].length;
+ }
+ sv.r.objects.objectList[pack][idx] =
+ new Array(line[1], line[2], line[3], line[4], line[5]);
+ }
+ }
+ sv.r.objects.displayObjectList();
+};
+
+// Display the list of objects in the tree
+sv.r.objects.displayObjectList = function(goback) {
+ var tb = document.getElementById("sciviews_robjects_filterbox");
+ var obRx = new RegExp(tb.value);
+
+ var node = document.getElementById("sciviews_robjects_objects_tree_main");
+ var k = 0;
+ var currentPack;
+ var currentFun;
+
+ for (var pack in sv.r.objects.objectList) {
+ currentPack = sv.r.objects.objectList[pack];
+ item =
+ <treeitem container="true" open="true">
+ <treerow>
+ <treecell label={pack} properties="package" />
+ <treecell label="" />
+ <treecell label="" />
+ <treecell label="" />
+ </treerow>
+ <treechildren />
+ </treeitem>;
+ item.treechildren.treeitem = new XMLList();
+ for (var i = 0; i < currentPack.length; i++) {
+ currentFun = currentPack[i];
+ if (obRx.test(currentFun[0])) {
+ item.treechildren.treeitem +=
+ <treeitem >
+ <treerow>
+ <treecell label={currentFun[0]}
+ properties={currentFun[3].replace(".", "-" )} />
+ <treecell label={currentFun[1]} />
+ <treecell label={currentFun[2]} />
+ <treecell label={currentFun[3]} />
+ </treerow>
+ </treeitem>;
+ }
+ }
+ sv.tools.e4x2dom.append(item, node, k);
+ k++;
+ }
+ if(goback) tb.focus();
+};
+
+// Change the display status of a package by clicking an item in the list
+sv.r.objects.packageSelectedEvent = function(event) {
+ var cb = event.target;
+ var status = cb.checked;
+ var spid = cb.getAttribute("spid");
+ sv.r.objects.packageSelected(spid, status);
+};
+
+// Process selection/deselection of packages
+sv.r.objects.packageSelected = function(pack, status) {
+ if (status) {
+ if (!sv.r.objects.__isSelected(pack)) {
+ sv.r.objects.__addPackageToSelection(pack);
+ }
+ } else {
+ if (sv.r.objects.__isSelected(pack)) {
+ sv.r.objects.__removePackageFromSelection(pack);
+ }
+ }
+};
+
+// Function that indicates whether a package is selected
+sv.r.objects.__isSelected = function(p) {
+ return(sv.tools.array.contains(sv.r.objects.searchPathsSelected, p));
+};
+
+// Add content of package to the tree
+sv.r.objects.__addPackageToSelection = function(p) {
+ sv.r.objects.searchPathsSelected[sv.r.objects.searchPathsSelected.length] = p;
+ sv.r.objects.addObjectList(p);
+};
+
+// Remove content of the package from the tree
+sv.r.objects.__removePackageFromSelection = function(p) {
+ sv.tools.array.remove(sv.r.objects.searchPathsSelected, p);
+ sv.r.objects.objectList =
+ sv.tools.array.removeItem(sv.r.objects.objectList, p);
+ sv.r.objects.displayObjectList();
+};
+
+// Make sure to check .GlobalEnv at the beginning
+// TODO: persitently save user's selection using Komodo mechanism
+sv.r.objects.packageSelected(".GlobalEnv", true);
Added: komodo/SciViews-K/content/js/sciviews.js
===================================================================
--- komodo/SciViews-K/content/js/sciviews.js (rev 0)
+++ komodo/SciViews-K/content/js/sciviews.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,385 @@
+// SciViews-K general functions
+// Define the basic 'sv' namespace
+// Copyright (c) 2008, Ph. Grosjean (phgrosjean at sciviews.org)
+
+////////////////////////////////////////////////////////////////////////////////
+// sv.version; // Get current SciViews-K version (major.minor)
+// sv.release; // The release (bug fixes). Full version is "version.release"
+// sv.checkVersion(version); // Check if the OpenKore extension version is fine
+//
+// Various functions defined in the 'sv' namespace directly
+// sv.getText(); // Get current selection, or word under the cursor
+// sv.getLine(); // Get current line in the active buffer
+// sv.getPart(what, resel, clipboard); // Get a part of text in the buffer
+ // or copy it to the clipboard (reset selection if resel == false)
+// sv.browseURI(URI, internal); // Show URI in internal or external browser
+// sv.showFile(path, readonly); // Show a file in Komodo, possibly as read-only
+// sv.helpURL(URL); // Display URL help in the default browser
+// sv.helpContext(); // Get contextual help for selected word in buffer in R or
+ // for active snippet in toolbox/project (see Help context)
+//
+// SciViews-K preferences management ('sv.prefs' namespace)
+// sv.prefs.getString(pref, def); // Get a preference, use 'def' is not found
+// sv.prefs.setString(pref, value, overwrite); // Set a preference string
+// sv.prefs.askString(pref, defvalue): // Ask for the value of a preference
+//
+// OpenKore Command Output management ('sv.cmdout' namespace)
+// sv.cmdout.append(str, newline); // Append text to the Command Output pane
+// sv.cmdout.clear(); // Clear the Command Output pane
+//
+////////////////////////////////////////////////////////////////////////////////
+
+if (typeof(sv) == 'undefined') {
+ sv = {
+ // TODO: set this automatically according to the plugin version
+ version: 0.6,
+ release: 0,
+ checkVersion: function(version) {
+ if (this.version < version) {
+ var title = "SciViews-K"
+ var prompt = "Outdated SciViews-K extension..."
+ var text = "One or more macros require the SciViews-K extension "
+ text += version + ".x"
+ text += " but the currently installed version is "
+ text += this.version + "." + this.release
+ text += ". You should update it."
+ text += " Would you like to open the extension manager"
+ text += " and check for available updates now?"
+ var res = ko.dialogs.yesNo(prompt, "Yes", text, title);
+ if (res == "Yes") ko.launch.openAddonsMgr();
+ return(false);
+ } else return(true);
+ }
+ };
+}
+// Create the 'sv.tools' namespace
+if (typeof(sv.tools) == 'undefined') sv.tools = new Object();
+
+// Other functions directly defined in the 'sv' namespace //////////////////////
+
+// Gets current selection, or word under the cursor in the active buffer
+sv.getText = function() {
+ var kv = ko.views.manager.currentView;
+ if (!kv) return("");
+ kv.setFocus();
+ var ke = kv.scimoz;
+ var txt = ke.selText;
+ // If selection is empty, get the word under the cursor
+ if (txt == "") txt = ko.interpolate.getWordUnderCursor(ke);
+ return(txt);
+};
+
+// Get current line of text in the active buffer
+sv.getLine = function() {
+ var kv = ko.views.manager.currentView;
+ if (!kv) return("");
+ kv.setFocus();
+ var ke = kv.scimoz;
+ // retain these so we can reset the selection after the replacement
+ var curAnchor = ke.anchor;
+ var curPos = ke.currentPos;
+ // Get the text in the current line
+ ke.home();
+ ke.lineEndExtend();
+ var currentLine = ke.selText;
+ // Reset the selection
+ ke.setSel(curAnchor, curPos);
+ // Return the content of the current line
+ return(currentLine);
+};
+
+// Select a part of text in the current buffer and return it
+sv.getPart = function(what, resel, clipboard) {
+ var text = "";
+ var kv = ko.views.manager.currentView;
+ if (kv) {
+ kv.setFocus();
+ var ke = kv.scimoz;
+ // retain these so we can reset the selection after the extraction
+ var curAnchor = ke.anchor;
+ var curPos = ke.currentPos;
+ var curLine = ke.lineFromPosition(curPos);
+ // Depending on 'what', we select different parts of the file
+ // By default, we keep current selection
+ switch(what) {
+ case "sel":
+ // Simply retain current selection
+ break;
+ //case "function":
+ // Try to select an entire R function
+ // TODO...
+ //break;
+ case "block":
+ // Select all content between two bookmarks
+ var Mark1 = ke.markerPrevious(curLine, -1);
+ if (Mark1 == -1) Mark1 = 0; // Select from the start of the document
+ var Mark2 = ke.markerNext(curLine, -1);
+ if (Mark2 == -1) Mark2 = ke.lineCount - 1; // Select to end of doc
+ ke.selectionStart = ke.positionFromLine(Mark1);
+ ke.selectionEnd = ke.positionFromLine(Mark2);
+ ke.lineEndExtend();
+ break;
+ case "para":
+ // Select the entire paragraph
+ ke.paraDown();
+ ke.paraUpExtend();
+ break;
+ case "line":
+ // Select whole current line
+ ke.home();
+ ke.lineEndExtend();
+ break;
+ case "linetobegin":
+ // Select line content from beginning to anchor
+ ke.lineUpExtend();
+ ke.lineEndExtend();
+ ke.charRightExtend();
+ break;
+ case "linetoend":
+ // Select line from anchor to end of line
+ ke.lineEndExtend();
+ break;
+ case "end":
+ // take text from current line to the end
+ ke.home();
+ ke.documentEndExtend();
+ break;
+ case "all":
+ default:
+ // Take everything
+ ke.selectAll();
+ }
+ if (clipboard) {
+ // Copy to clipboard instead of returning the text
+ ke.copy();
+ } else text = ke.selText;
+ // Possibly reset the selection
+ if (resel == false) ke.setSel(curAnchor, curPos);
+ }
+ return(text);
+};
+
+// Browse for the URI, either in an internal, or external (default) browser
+sv.browseURI = function(URI, internal) {
+ if (URI == "") {
+ alert("Item not found!"); // Because we call this from other
+ // functions that returns "" in case it doesn't find it (see sv.r.help)
+ } else {
+ if (internal == null)
+ internal = (sv.prefs.getString("sciviews.r.help",
+ "internal") == "internal");
+ if (internal == true) {
+ // TODO: open this in the R help pane, or in a buffer
+ ko.open.URI(URI, "browser");
+ } else {
+ ko.browse.openUrlInDefaultBrowser(URI);
+ }
+ }
+};
+
+// Show a text file in a buffer, possibly in read-only mode
+sv.showFile = function(path, readonly) {
+ if (path == "") {
+ alert("Item not found!"); // Same remark as for sv.browseURI()
+ } else {
+ ko.open.URI(path, "editor");
+ if (readonly == true) {
+ var kv = ko.views.manager.currentView;
+ var ke = kv.scimoz;
+ ke.readOnly = true;
+ // Make the caret a block and hatch the fold margin as indicator
+ ke.caretStyle = 2;
+ ke.setFoldMarginColour(true, 100);
+ kv.setFocus();
+ }
+ }
+};
+
+// Show URL in the default browser with current selection or <keyword>
+sv.helpURL = function(URL) {
+ try {
+ var kv = ko.views.manager.currentView;
+ if (!kv) return(false);
+ kv.setFocus();
+ var ke = kv.scimoz;
+ var sel = ke.selText;
+ if (sel == "") {
+ // Try to get the URL-escaped word under the cursor
+ if (ko.interpolate.getWordUnderCursor(ke) == "") {
+ alert("Nothing is currently selected!");
+ return(false);
+ } else {
+ sel = ko.interpolate.interpolateStrings('%W');
+ }
+ } else {
+ // Get the URL-escaped selection
+ sel = ko.interpolate.interpolateStrings('%S');
+ }
+ var helpURL = URL.replace("<keyword>", sel);
+ ko.browse.openUrlInDefaultBrowser(helpURL);
+ return(true);
+ } catch(e) { alert(e); }
+};
+
+// Get contextual help for a word in the buffer, or for snippets
+sv.helpContext = function() {
+ try {
+ if (ko.window.focusedView() == null) {
+ if (ko.projects.active) {
+ var item = ko.projects.active.getSelectedItem();
+ var content = item.value;
+ // Look for a string defining the URL for associated help file
+ // This is something like: [[%pref:URL|R|RWiki-help:<value>]]
+
+ // Look for URL-help
+ var help = content.replace(/^.*\[\[%pref:URL-help:([^\]]*)]].*$/,
+ '$1');
+ if (help != content) { // Found!
+ // Show in default browser
+ // TODO: a quick 'R help' tab to show this
+ ko.browse.openUrlInDefaultBrowser(help);
+ return(true);
+ }
+
+ // Look for R-help
+ help = content.replace(/^.*\[\[%pref:R-help:([^\]]*)]].*$/,
+ '$1');
+ if (help != content) { // Found!
+ // Do the help command in R
+ sv.r.help(help);
+ return(true);
+ }
+
+ // Look for RWiki-help
+ help = content.replace(/^.*\[\[%pref:RWiki-help:([^\]]*)]].*$/,
+ '$1');
+ if (help != content) { // Found!
+ // Get the RWiki base URL
+ var baseURL = "http:/wiki.r-project.org/rwiki/doku.php?id="
+ baseURL = sv.prefs.getString("sciviews.rwiki.help.base",
+ baseURL);
+ // Display the RWiki page
+ // TODO: display this in the quick 'R help' tab
+ ko.browse.openUrlInDefaultBrowser(baseURL + help);
+ return(true);
+ }
+
+ // No help data found
+ var msg = "No help found for this tool!";
+ StatusBar_AddMessage(msg, "debugger", 5000, true);
+ return(false);
+ }
+ } else { // The focus is currently on a buffer
+ // Try to get R help for current word
+ topic = sv.getText();
+ if (topic == "") {
+ alert("Nothing is selected!");
+ } else sv.r.help(topic);
+ }
+ return(true);
+ } catch(e) {
+ alert("Error while trying to get contextual help");
+ return(false);
+ }
+};
+
+
+// Preferences management //////////////////////////////////////////////////////
+if (typeof(sv.prefs) == 'undefined') sv.prefs = new Object();
+
+// Get a string preference, or default value
+sv.prefs.getString = function(pref, def) {
+ var prefsSvc = Components.classes["@activestate.com/koPrefService;1"].
+ getService(Components.interfaces.koIPrefService);
+ var prefs = prefsSvc.prefs;
+ if (prefs.hasStringPref(pref)) {
+ return(prefs.getStringPref(pref));
+ } else return(def);
+};
+
+// Set a string preference
+sv.prefs.setString = function(pref, value, overwrite) {
+ var prefsSvc = Components.classes["@activestate.com/koPrefService;1"].
+ getService(Components.interfaces.koIPrefService);
+ var prefs = prefsSvc.prefs;
+ if (overwrite == false & prefs.hasStringPref(pref)) return;
+ prefs.setStringPref(pref, value);
+};
+
+// Display a dialog box to change a preference string
+sv.prefs.askString = function(pref, defvalue) {
+ var prefsSvc = Components.classes["@activestate.com/koPrefService;1"].
+ getService(Components.interfaces.koIPrefService);
+ var prefs = prefsSvc.prefs;
+ // If defvalue is defined, use it, otherwise, use current pref value
+ if (defvalue == null & prefs.hasStringPref(pref))
+ defvalue = prefs.getStringPref(pref);
+ if (defvalue == null) defvalue == "";
+ // Display a dialog box to change the preference value
+ newvalue = ko.dialogs.prompt("Change preference value for:", pref,
+ defvalue, "SciViews-K preference", "svPref" + pref)
+ if (newvalue != null) prefs.setStringPref(pref, newvalue);
+}
+
+
+// This is required by sv.helpContext() for attaching help to snippets (hack!)
+// Create empty preference sets to be used with snippet help system hack
+// [[%pref:R-help:value]] which displays nothing when the snippet is used
+// but can be used to retrieve value to display a particular help page
+// for this snippet
+// Help page triggered by a given URL
+sv.prefs.setString("URL-help", "", true);
+// R HTML help pages triggered with '?topic'
+sv.prefs.setString("R-help", "", true);
+// Help page on the R Wiki
+sv.prefs.setString("RWiki-help", "", true);
+
+
+// Control the command output tab //////////////////////////////////////////////
+if (typeof(sv.cmdout) == 'undefined') sv.cmdout = new Object();
+
+// Append text to the Command Output pane
+sv.cmdout.append = function(str, newline) {
+ try {
+ var runout = ko.run.output;
+ // Make sure the command output window is visible
+ runout.show(window, false);
+ // Make sure we're showing the output pane
+ var deckWidget = document.getElementById("runoutput-deck");
+ if (deckWidget.getAttribute("selectedIndex") != 0) {
+ runout.toggleView();
+ }
+ // Find out the newline sequence uses, and write the text to it.
+ var scimoz = document.getElementById("runoutput-scintilla").scimoz;
+ var prevLength = scimoz.length;
+ if (newline == null) str += ["\r\n", "\n", "\r"][scimoz.eOLMode];
+ var str_byte_length = ko.stringutils.bytelength(str);
+ var ro = scimoz.readOnly;
+ try {
+ scimoz.readOnly = false;
+ scimoz.appendText(str_byte_length, str);
+ } finally { scimoz.readOnly = ro; }
+ // Bring the new text into view
+ scimoz.gotoPos(prevLength + 1);
+ } catch(e) { alert("Problems printing [" + str + "]:" + e + "\n"); }
+};
+
+// Clear text in the Output Command pane
+sv.cmdout.clear = function() {
+ try {
+ var runout = ko.run.output;
+ // Make sure the command output window is visible
+ runout.show(window, false);
+ // Make sure we're showing the output pane
+ var deckWidget = document.getElementById("runoutput-deck");
+ if (deckWidget.getAttribute("selectedIndex") != 0) {
+ runout.toggleView();
+ }
+ var scimoz = document.getElementById("runoutput-scintilla").scimoz;
+ var ro = scimoz.readOnly;
+ try {
+ scimoz.readOnly = false;
+ scimoz.clearAll();
+ } finally { scimoz.readOnly = ro; }
+ } catch(e) { alert("problems clearing the Command Output pane\n"); }
+};
Added: komodo/SciViews-K/content/js/socket.js
===================================================================
--- komodo/SciViews-K/content/js/socket.js (rev 0)
+++ komodo/SciViews-K/content/js/socket.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,281 @@
+// SciViews-K socket client/server functions
+// Socket client and server functions to connect to R kernels
+// Copyright (c) 2008, Ph. Grosjean (phgrosjean at sciviews.org)
+
+////////////////////////////////////////////////////////////////////////////////
+// To cope with versions incompatibilities, we define this:
+// sv.socket.svSocketMinVersion // minimal svSocket version required
+//
+/////// Socket client //////
+// Parameters:
+// sv.socket.host; // The address of the R server host (local only for now)
+// sv.socket.cmdout // Do we echo exchange to the Output Command pane?
+// sv.socket.promt // Look at this to know if we are in multiline mode
+// sv.socket.cmd // In case of multiline mode, the partial command so far
+//
+// sv.socket.rClient(host, port, outputData, listener, echo); // Main client fct
+// sv.socket.rCommand(cmd); // Send cmd to the R socket server for evaluation
+//
+/////// Socket server //////
+// Parameters:
+// sv.socket.debug // Debugging mode (in Command Output)
+// sv.socket.serverIsLocal // Is the socket servicing only localhost?
+//
+// sv.socket.serverStart(); // Start the OpenKore socket server
+// sv.socket.serverStop(); // Stop the OpenKore socket server
+// sv.socket.serverIsStarted(); // Is the socket server currently started?
+// sv.socket.serverConfig(); // Get a short description of server config
+// sv.socket.serverWrite(data); // Write a string through the socket server
+////////////////////////////////////////////////////////////////////////////////
+
+// Define the 'sv.socket' namespace
+if (typeof(sv.socket) == 'undefined') sv.socket = new Object();
+
+// Will be used later for compatibility checking between R and Komodo tools
+sv.socket.svSocketMinVersion = "0.9-40";
+
+
+/////// Socket client //////////////////////////////////////////////////////////
+sv.socket.host = "127.0.0.1"; // Host to connect to (local host only, currently)
+sv.socket.cmdout = true; // Do we write to 'Command Output'?
+sv.socket.prompt = ":> "; // The prompt, could be changed o continue prompt
+sv.socket.cmd = ""; // The command to send to R
+
+// The main socket client function to connect to R socket server
+sv.socket.rClient = function(host, port, outputData, listener, echo, echofun) {
+ try {
+ var transportService = Components.
+ classes["@mozilla.org/network/socket-transport-service;1"]
+ .getService(Components.interfaces.nsISocketTransportService);
+ var transport = transportService.createTransport(null, 0,
+ host, port, null);
+
+ var outstream = transport.openOutputStream(0, 0, 0);
+ outstream.write(outputData, outputData.length);
+
+ var stream = transport.openInputStream(0, 0, 0);
+ var instream = Components.
+ classes["@mozilla.org/scriptableinputstream;1"]
+ .createInstance(Components.interfaces.nsIScriptableInputStream);
+ instream.init(stream);
+
+ var dataListener = {
+ data: "",
+ onStartRequest: function(request, context) { this.data = ""; },
+ onStopRequest: function(request, context, status) {
+ instream.close();
+ outstream.close();
+ this.data = sv.tools.strings.removeLastCRLF(this.data);
+ listener.finished(this.data);
+ },
+ onDataAvailable: function(request, context,
+ inputStream, offset, count) {
+ // TODO: limit the total amount of data send through the socket!
+ var chunk = instream.read(count);
+ // Determine if we have a prompt at the end
+ var cl = chunk.length;
+ if (chunk.substring(cl-5, cl-3) == "> " |
+ chunk.substring(cl-4, cl-2) == "> ") {
+ sv.socket.prompt = ":> ";
+ }
+ if (chunk.substring(cl-5, cl-3) == "+ " |
+ chunk.substring(cl-4, cl-2) == "+ ") {
+ sv.socket.prompt = ":+ ";
+ }
+ // Do we need to close the connection
+ // (\f received, followed by \n, \r, or both)?
+ if (chunk.match("\n\f") == "\n\f") {
+ instream.close();
+ outstream.close();
+ // Eliminate the trailing (\r)\n\f chars before the prompt
+ if (chunk.indexOf("\r\n\f") > -1) {
+ chunk = chunk.replace("\r\n\f", "");
+ } else {
+ chunk = chunk.replace("\n\f", "");
+ }
+ // Eliminate the last carriage return after the prompt
+ chunk = chunk.replace(/ \r?\n?$/, " ");
+ }
+ this.data += chunk;
+ // Do we "echo" these results somewhere?
+ if (echo) {
+ if (echofun == null) {
+ // Use default echo function (to the Command Output)
+ sv.cmdout.append(chunk, newline = false);
+ } else echofun(chunk);
+ }
+ },
+ }
+
+ var pump = Components.
+ classes["@mozilla.org/network/input-stream-pump;1"].
+ createInstance(Components.interfaces.nsIInputStreamPump);
+ pump.init(stream, -1, -1, 0, 0, false);
+ pump.asyncRead(dataListener, null);
+ } catch (e) { return(e); }
+ return(null);
+}
+
+// Send an R command through the socket
+sv.socket.rCommand = function(cmd, echo, echofun, procfun) {
+ cmd = sv.tools.strings.replaceCRLF(cmd, "<<<n>>>");
+ if (procfun == null) { // Do nothing at the end
+ var listener = { finished: function(data) {} }
+ } else { // Call procfun at the end
+ var listener = { finished: function(data) { procfun(data); } }
+ }
+ // TODO: deal with error checking for this command
+ var port = sv.prefs.getString("sciviews.client.socket", "8888");
+ var id = "<<<id=" + sv.prefs.getString("sciviews.client.id", "SciViewsK") +
+ ">>>";
+ var res = sv.socket.rClient(sv.socket.host, port, id + cmd + "\n",
+ listener, echo, echofun);
+ return(res);
+}
+//sv.socket.rCommand("<<<q>>>cat('library = '); str(library)");
+
+
+/////// Socket server //////////////////////////////////////////////////////////
+sv.socket.debug = false; // Set to true for debugging mode
+sv.socket.serverIsLocal = true; // Is the socket servicing only localhost?
+
+const nsITransport = Components.interfaces.nsITransport;
+
+var serverSocket; // The SviViews-K socket server object
+var serverStarted = false; // Is the socket server started?
+var inputString; // The string with the command send by the client
+var outputString; // The string with the result to send to the client
+
+// Core function for the SciViews-K socket server: create the serverSocket object
+sv.socket.serverStart = function() {
+ var listener = {
+ onSocketAccepted : function(socket, transport) {
+ try {
+ // Make sure to clean input and output strings before use
+ inputString = "";
+ outputString = "";
+ if (sv.socket.debug) {
+ sv.cmdout.clear();
+ sv.cmdout.append("#--# SciViews-K socket client: " +
+ transport.host + " on port " + transport.port + "\n");
+ }
+
+ // Then, read data from the client
+ var inputStream = transport.openInputStream(nsITransport.
+ OPEN_BLOCKING, 0, 0);
+ var sin = Components.
+ classes["@mozilla.org/scriptableinputstream;1"]
+ .createInstance(Components.interfaces.
+ nsIScriptableInputStream);
+ sin.init(inputStream);
+
+ // Wait for input up to 10 sec max, with synchroneous com only)
+ var millis = 10000;
+ var date = new Date();
+ var curDate = null;
+ do {
+ curDate = new Date();
+ inputString = sin.read(512);
+ } while(inputString == "" & curDate - date < millis)
+
+ // Read the complete data
+ while (sin.available() > 0)
+ inputString += sin.read(512);
+
+ // Is there data send?
+ if (inputString == "") {
+ outputString += "Error: no command send!\n"
+ } else {
+ // Process the command
+ if (sv.socket.debug) sv.cmdout.append("#--# Command send" +
+ " by the client:\n" + inputString);
+ try {
+ ko.commands.doCode(1, inputString);
+ } catch(cmderr) {
+ if (cmderr) outputString += "\nError: " + cmderr;
+ }
+ }
+ if (sv.socket.debug) {
+ if (outputString == "") {
+ sv.cmdout.append("#--# Nothing to return" +
+ " to the socket client");
+ } else {
+ sv.cmdout.append("#--# Result:\n" + outputString);
+ }
+ }
+
+ // And finally, return the result to the socket client
+ // (append \n at the end)
+ outputString += "\n";
+ var outputStream = transport.openOutputStream(nsITransport.
+ OPEN_BLOCKING, 0, 0);
+ outputStream.write(outputString, outputString.length);
+ } catch(e) {
+ dump(e);
+ } finally {
+ // Make sure that streams are closed
+ outputStream.close();
+ inputStream.close();
+ }
+ },
+
+ onStopListening : function(socket, status) {
+ // The connection is closed by the client
+ if (sv.socket.debug)
+ sv.cmdout.append("#--# SciViews-K socket closed");
+ }
+ };
+
+ try {
+ serverSocket = Components.
+ classes["@mozilla.org/network/server-socket;1"]
+ .createInstance(Components.interfaces.nsIServerSocket);
+ var port = sv.prefs.getString("sciviews.server.socket", "7052");
+ serverSocket.init(port, sv.socket.serverIsLocal, -1);
+ serverSocket.asyncListen(listener);
+ } catch(ex) { dump(ex); }
+ serverStarted = true;
+ if (sv.socket.debug)
+ ko.statusBar.AddMessage("SciViews-K socket server started", "svSock",
+ 2000, true);
+}
+
+// Stop the SciViews-K socket server
+sv.socket.serverStop = function() {
+ if (serverStarted) {
+ serverSocket.close();
+ serverStarted = false;
+ ko.statusBar.AddMessage("SciViews-K socket server stopped",
+ "svSock", 2000, true);
+ } else {
+ ko.statusBar.AddMessage("SciViews-K socket server is not started",
+ "svSock", 2000, true);
+ }
+}
+
+// Is the SciViews-K socket server started?
+sv.socket.serverIsStarted = function() {
+ return(serverStarted);
+}
+
+// What is the current SciViews-K socket server config?
+sv.socket.serverConfig = function() {
+ var serverStatus = " (stopped)"
+ if (serverStarted) serverStatus = " (started)"
+ var port = sv.prefs.getString("sciviews.server.socket", "7052");
+ if (sv.socket.serverIsLocal) {
+ return("Local socket server on port " + port + serverStatus);
+ } else {
+ return("Global socket server on port " + port + serverStatus);
+ }
+}
+
+// Write to the socket server, use this to return something to the client
+sv.socket.serverWrite = function(data) {
+ if (serverStarted) {
+ outputString += data;
+ } else {
+ alert("Trying to write data though the SciViews-K socket server" +
+ " that is not started!")
+ }
+}
Added: komodo/SciViews-K/content/js/tools/array.js
===================================================================
--- komodo/SciViews-K/content/js/tools/array.js (rev 0)
+++ komodo/SciViews-K/content/js/tools/array.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,38 @@
+// SciViews-K functions
+// Various functions to manipulate arrays
+// by Romain Francois
+
+////////////////////////////////////////////////////////////////////////////////
+// sv.tools.array.remove(a, s); // Eliminate 's' from 'a'
+// sv.tools.array.contains(a, s); // Does array 'a' contain 's'
+// sv.tools.array.removeItem(a, s); // Return an array with 's' removed from 'a'
+////////////////////////////////////////////////////////////////////////////////
+
+// Define the 'sv.tools.array' namespace
+if (typeof(sv.tools.array) == 'undefined') sv.tools.array = new Object();
+
+// Remove 's' from the array 'a'
+sv.tools.array.remove = function(a, s) {
+ for (i = 0; i < a.length; i++) {
+ if (s == a[i]) a.splice(i, 1);
+ }
+}
+
+// Does the array 'a' contain 's'?
+sv.tools.array.contains = function(a, s) {
+ for (i = 0; i< a.length; i++) {
+ if (s == a[i]) return(true);
+ }
+ return(false);
+}
+
+// Return an array from which 's' item is eliminated fro the array 'a'
+sv.tools.array.removeItem = function(a, s) {
+ b = [];
+ for (i in a) {
+ if (i != s) {
+ b[i] = a[i]
+ }
+ }
+ return(b);
+}
Added: komodo/SciViews-K/content/js/tools/e4x2dom.js
===================================================================
--- komodo/SciViews-K/content/js/tools/e4x2dom.js (rev 0)
+++ komodo/SciViews-K/content/js/tools/e4x2dom.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,75 @@
+// SciViews-K functions
+// From this post and modified by R. Francois so that it works with XUL:
+// http://ecmanaut.blogspot.com/2006/03/e4x-and-dom.html
+
+////////////////////////////////////////////////////////////////////////////////
+// sv.tools.e4x2dom.importNode(e4x, doc); // Translate e4x node to DOM node
+// sv.tools.e4x2dom.appendTo(e4x, node, doc); // Append e4x node to a DOM node
+// sv.tools.e4x2dom.setContent(e4x, node); // Idem, but clear DOM node first
+// sv.tools.e4x2dom.append(e4x, node, i); // Append at 'i'th position
+// sv.tools.e4x2dom.clear(node); // Clear a DOM node
+// sv.tools.e4x2dom.d4e(domNode); // Translate DOM node to e4x node
+////////////////////////////////////////////////////////////////////////////////
+
+// Define the 'sv.tools.e4x2dom' namespace
+if (typeof(sv.tools.e4x2dom) == 'undefined') sv.tools.e4x2dom = new Object();
+
+// Translate e4x (JavaScript) node into a DOM node
+sv.tools.e4x2dom.importNode = function(e4x, doc) {
+ var me = this.importNode, xhtml, domTree, importMe;
+ me.Const = me.Const || { mimeType: 'text/xml' };
+ me.Static = me.Static || {};
+ me.Static.parser = me.Static.parser || new DOMParser;
+ xhtml = <testing
+ xmlns:html="http://www.w3.org/1999/xhtml"
+ xmlns:svg="http://www.w3.org/2000/svg"
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul"/>;
+ xhtml.test = e4x;
+ domTree = me.Static.parser.parseFromString( xhtml.toXMLString().
+ replace( />\n *</g, "><" ), me.Const.mimeType);
+ importMe = domTree.documentElement.firstChild;
+ while(importMe && importMe.nodeType != 1)
+ importMe = importMe.nextSibling;
+ if(!doc) doc = document;
+ return importMe ? doc.importNode(importMe, true) : null;
+}
+
+// Append an e4x node to a DOM node
+sv.tools.e4x2dom.appendTo = function(e4x, node, doc) {
+ return(node.appendChild(this.importNode(e4x, doc || node.ownerDocument)));
+}
+
+// Append an e4x node to a DOM node, clearing it first
+sv.tools.e4x2dom.setContent = function(e4x, node) {
+ this.clear(node);
+ this.appendTo(e4x, node);
+}
+
+// Append an e4x node to a DOM node, clear first or not depending on 'i'
+sv.tools.e4x2dom.append = function(e4x, node, i) {
+ if (i == 0) {
+ this.setContent(e4x, node);
+ } else {
+ this.appendTo(e4x, node);
+ }
+}
+
+// Clear a DOM node
+sv.tools.e4x2dom.clear = function(node) {
+ while(node.firstChild)
+ node.removeChild(node.firstChild);
+}
+
+// Translate a DOM node into an e4x (JavaScript) node
+sv.tools.e4x2dom.d4e = function(domNode) {
+ var xmls = new XMLSerializer();
+ return(new XML(xmls.serializeToString(domNode)));
+}
+
+var HTML = "http://www.w3.org/1999/xhtml";
+var XUL = "http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul";
+var SVG = "http://www.w3.org/2000/svg";
+var RDF = "http://www.w3.org/1999/02/22-rdf-syntax-ns#";
+
+default xml namespace = "http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul";
Added: komodo/SciViews-K/content/js/tools/strings.js
===================================================================
--- komodo/SciViews-K/content/js/tools/strings.js (rev 0)
+++ komodo/SciViews-K/content/js/tools/strings.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,35 @@
+// SciViews-K functions
+// Various functions to manipulate strings
+// by Philippe Grosjean and Romain Francois
+
+////////////////////////////////////////////////////////////////////////////////
+// sv.tools.strings.replaceCRLF(str, code); // Replace LF and CR by 'code'
+// sv.tools.strings.removeLastCRLF(str); // Remove last CR and or LF
+////////////////////////////////////////////////////////////////////////////////
+
+// Define the 'sv.tools.strings' namespace
+if (typeof(sv.tools.strings) == 'undefined') sv.tools.strings = new Object();
+
+// Replace line feed and carriage return by 'code'
+sv.tools.strings.replaceCRLF = function(str, code) {
+ // Replace all \r\n by 'code' in cmd
+ while (str.indexOf("\r\n") > -1) {
+ str = str.replace("\r\n", code);
+ }
+ // Replace all \n by 'code' in cmd
+ while (str.indexOf("\n") > -1) {
+ str = str.replace("\n", code);
+ }
+ // Replace all \r by 'code' in cmd
+ while (str.indexOf("\r") > -1) {
+ str = str.replace("\r", code);
+ }
+ return(str);
+}
+
+// Remove the last line feed and or carriage return in the text
+sv.tools.strings.removeLastCRLF = function(str) {
+ str = str.replace( /[\n\r]{1,2}$/, "");
+ return(str);
+}
+
Added: komodo/SciViews-K/content/overlay.xul
===================================================================
--- komodo/SciViews-K/content/overlay.xul (rev 0)
+++ komodo/SciViews-K/content/overlay.xul 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,172 @@
+<?xml version="1.0"?>
+<!-- ***** BEGIN LICENSE BLOCK *****
+ Version: MPL 1.1/GPL 2.0/LGPL 2.1
+
+ The contents of this file are subject to the Mozilla Public License
+ Version 1.1 (the "License"); you may not use this file except in
+ compliance with the License. You may obtain a copy of the License at
+ http://www.mozilla.org/MPL/
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
+ License for the specific language governing rights and limitations
+ under the License.
+
+ The Original Code is SciViews-K by Philippe Grosjean & Romain Francois.
+
+ Portions created by ActiveState Software Inc are Copyright (C) 2000-2008
+ ActiveState Software Inc. All Rights Reserved.
+
+ Contributor(s):
+ Philippe Grosjean
+ Romain Francois
+ ActiveState Software Inc
+
+ Alternatively, the contents of this file may be used under the terms of
+ either the GNU General Public License Version 2 or later (the "GPL"), or
+ the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
+ in which case the provisions of the GPL or the LGPL are applicable instead
+ of those above. If you wish to allow use of your version of this file only
+ under the terms of either the GPL or the LGPL, and not to allow others to
+ use your version of this file under the terms of the MPL, indicate your
+ decision by deleting the provisions above and replace them with the notice
+ and other provisions required by the GPL or the LGPL. If you do not delete
+ the provisions above, a recipient may use your version of this file under
+ the terms of any one of the MPL, the GPL or the LGPL.
+
+ ***** END LICENSE BLOCK ***** -->
+<!DOCTYPE overlay PUBLIC "-//MOZILLA//DTD XUL V1.0//EN" "http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul" [
+ <!ENTITY % sciviewskDTD SYSTEM "chrome://sciviewsk/locale/sciviewsk.dtd">
+ %sciviewskDTD;
+]>
+
+<?xml-stylesheet href="chrome://global/skin/global.css" type="text/css"?>
+<?xml-stylesheet href="chrome://komodo/skin/global/global.p.css" type="text/css"?>
+<?xml-stylesheet href="chrome://komodo/skin/bindings/buttons.css" type="text/css"?>
+<?xml-stylesheet href="chrome://sciviewsk/skin/sciviewsk.css" type="text/css"?>
+
+<overlay id="sciviewskOverlay"
+ xmlns:html="http://www.w3.org/1999/xhtml"
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul">
+
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/sciviews.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/prefs.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/tools/strings.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/tools/e4x2dom.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/tools/array.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/socket.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/r.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/robjects.js"/>
+
+ <commandset id="allcommands">
+ <command id="Tasks:svAbout" oncommand="alert('SciViews-K (Komodo R Editor) version ' + sv.version + '\na Komodo extension to interact with R\n(see http://www.sciviews.org/SciViews-K)');"/>
+ </commandset>
+
+ <menupopup id="popup_tools">
+ <menuitem id="menu_sciviews"
+ label="SciViews-K"
+ observes="Tasks:svAbout"
+ class="menu-iconic-wide"/>
+ </menupopup>
+
+ <menupopup id="tabPicker_popup">
+ <menuitem id="show_robjects_tab"
+ insertafter="show_codebrowser_tab"
+ oncommand="uilayout_ensureTabShown('sciviews_robjects_tab', true)"
+ label="&sciviews.robjects.tab;"
+ />
+ </menupopup>
+
+ <menupopup id="menu_view_tabs_popup">
+ <menuitem id="show_robjects_tab2"
+ insertafter="show_codebrowser_tab2"
+ class="menuitem-iconic-wide"
+ oncommand="uilayout_ensureTabShown('sciviews_robjects_tab', true)"
+ label="&sciviews.robjects.tab;"
+ />
+ </menupopup>
+
+ <tabbox id="leftTabBox">
+ <tabs id="project_toolbox_tabs">
+ <tab id="sciviews_robjects_tab"
+ label="&sciviews.robjects.tab;"
+ insertafter="codebrowser_tab"
+ tooltiptext="&sciviews.robjects.tip;"
+ onclick="sv.r.objects.getPackageList()" />
+ </tabs>
+ <tabpanels id="project_toolbox_tabpanels">
+ <tabpanel flex="1" id="sciviews_robjects_tabpanel"
+ insertafter="codebrowserviewbox">
+ <vbox flex="1" id="sciviews_robjects_vbox">
+ <hbox align="center"
+ id="sciviews_robjects_hbox"
+ style="margin: 0px 2px;">
+ <toolbarbutton
+ id="sciviews_robjects_refresh_button"
+ tooltiptext="&sciviews.robjects.refresh.tip;"
+ buttonstyle="pictures"
+ label="&sciviews.robjects.refresh;"
+ class="refresh-icon button-toolbar-a"
+ oncommand="sv.r.objects.getPackageList();"
+ />
+ <toolbarbutton
+ id="sciviews_robjects_searchpath_button"
+ tooltiptext="&sciviews.robjects.showHide.tip;"
+ buttonstyle="pictures"
+ label="&sciviews.robjects.showHide;"
+ class="searchPath-icon button-toolbar-a"
+ oncommand="sv.r.objects.searchpath();"
+ />
+ <toolbarseparator style="min-width:10px;" flex="1"/>
+ <image id="sciviews_robjects_filter_icon"
+ tooltiptext="&sciviews.robjects.filter.tip;"
+ class="codeintel-search"/>
+ <textbox
+ id="sciviews_robjects_filterbox"
+ style="min-width:40px; max-width:200px; margin-right:0px;"
+ flex="1"
+ type="timed"
+ timeout="500"
+ tooltiptext="&sciviews.robjects.filter.tip;"
+ oninput="sv.r.objects.displayObjectList(false);"
+ />
+ </hbox>
+ <vbox>
+ <listbox flex="1" id="sciviews_robjects_searchpath_listbox"/>
+ </vbox>
+ <splitter
+ id="sciviews_robjects_splitter"
+ collapse="before"
+ resizeafter="closest"
+ resizebefore="closest"
+ state="collapsed">
+ <grippy tooltiptext="&sciviews.robjects.showHide.tip;"/>
+ </splitter>
+ <vbox flex="5">
+ <tree flex="1" id="sciviews_robjects_objects_tree" >
+ <treecols>
+ <treecol label="&sciviews.robjects.Name;" primary="true" flex="4"/>
+ <treecol label="&sciviews.robjects.Dims;" flex="1"/>
+ <treecol label="&sciviews.robjects.Group;" flex="1" hidden="true" />
+ <treecol label="&sciviews.robjects.Class;" flex="1" hidden="true" />
+ </treecols>
+ <!--<treechildren id="sciviews_robjects_objects_tree_main" ondraggesture="nsDragAndDrop.startDrag(event,RObjectObserver);" />-->
+ <treechildren id="sciviews_robjects_objects_tree_main">
+ <treeitem>
+ <treerow>
+ <treecell label="" />
+ <treecell label="" />
+ <treecell label="" />
+ <treecell label="" />
+ </treerow>
+ </treeitem>
+ </treechildren>
+ </tree>
+ </vbox>
+ </vbox>
+ </tabpanel>
+ </tabpanels>
+ </tabbox>
+
+</overlay>
Added: komodo/SciViews-K/install.rdf
===================================================================
--- komodo/SciViews-K/install.rdf (rev 0)
+++ komodo/SciViews-K/install.rdf 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,67 @@
+<?xml version="1.0"?>
+
+
+<!-- ***** BEGIN LICENSE BLOCK *****
+ Version: MPL 1.1/GPL 2.0/LGPL 2.1
+
+ The contents of this file are subject to the Mozilla Public License
+ Version 1.1 (the "License"); you may not use this file except in
+ compliance with the License. You may obtain a copy of the License at
+ http://www.mozilla.org/MPL/
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
+ License for the specific language governing rights and limitations
+ under the License.
+
+ The Original Code is OpenKore code for Komodo (from ActiveState Software Inc)
+ developed in the framework of the SciViews project, and sponsored by the
+ UNCOVER E.U. program.
+
+ Contributor(s):
+ Romain Francois (rfrancois at mango-solutions.com)
+ Philippe Grosjean (phgrosjean at sciviews.org)
+
+ Alternatively, the contents of this file may be used under the terms of
+ either the GNU General Public License Version 2 or later (the "GPL"), or
+ the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
+ in which case the provisions of the GPL or the LGPL are applicable instead
+ of those above. If you wish to allow use of your version of this file only
+ under the terms of either the GPL or the LGPL, and not to allow others to
+ use your version of this file under the terms of the MPL, indicate your
+ decision by deleting the provisions above and replace them with the notice
+ and other provisions required by the GPL or the LGPL. If you do not delete
+ the provisions above, a recipient may use your version of this file under
+ the terms of any one of the MPL, the GPL or the LGPL.
+
+ ***** END LICENSE BLOCK ***** -->
+
+<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:em="http://www.mozilla.org/2004/em-rdf#">
+ <Description about="urn:mozilla:install-manifest">
+ <em:id>sciviewsk at sciviews.org</em:id>
+ <em:name>SciViews-K</em:name>
+ <em:version>0.6.0</em:version>
+ <em:description>SciViews-K - Edit R (http://www.r-project.org) code in Komodo</em:description>
+ <em:creator>Philippe Grosjean and Romain Francois</em:creator>
+ <em:homepageURL>http://sciviews.org/SciViews-K</em:homepageURL>
+ <em:type>2</em:type> <!-- type=extension -->
+
+ <em:targetApplication>
+ <Description>
+ <!-- Komodo IDE's uuid -->
+ <em:id>{36E66FA0-F259-11D9-850E-000D935D3368}</em:id>
+ <em:minVersion>4.1</em:minVersion>
+ <em:maxVersion>4.4.*</em:maxVersion>
+ </Description>
+ </em:targetApplication>
+ <em:targetApplication>
+ <Description>
+ <!-- Komodo Edit's uuid -->
+ <em:id>{b1042fb5-9e9c-11db-b107-000d935d3368}</em:id>
+ <em:minVersion>4.1</em:minVersion>
+ <em:maxVersion>4.4.*</em:maxVersion>
+ </Description>
+ </em:targetApplication>
+ </Description>
+</RDF>
Added: komodo/SciViews-K/locale/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/locale/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/locale/en-GB/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/locale/en-GB/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/locale/en-GB/sciviewsk.dtd
===================================================================
--- komodo/SciViews-K/locale/en-GB/sciviewsk.dtd (rev 0)
+++ komodo/SciViews-K/locale/en-GB/sciviewsk.dtd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,11 @@
+<!ENTITY sciviews.robjects.tab "R Objects">
+<!ENTITY sciviews.robjects.tip "R objects explorer">
+<!ENTITY sciviews.robjects.refresh "Refresh">
+<!ENTITY sciviews.robjects.refresh.tip "Refresh R objects">
+<!ENTITY sciviews.robjects.showHide "Search path">
+<!ENTITY sciviews.robjects.showHide.tip "Show/hide search path">
+<!ENTITY sciviews.robjects.filter.tip "Filter the names of the objects">
+<!ENTITY sciviews.robjects.Name "Name">
+<!ENTITY sciviews.robjects.Dims "Dims">
+<!ENTITY sciviews.robjects.Group "Group">
+<!ENTITY sciviews.robjects.Class "Class">
Added: komodo/SciViews-K/locale/fr-FR/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/locale/fr-FR/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/locale/fr-FR/sciviewsk.dtd
===================================================================
--- komodo/SciViews-K/locale/fr-FR/sciviewsk.dtd (rev 0)
+++ komodo/SciViews-K/locale/fr-FR/sciviewsk.dtd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,11 @@
+<!ENTITY sciviews.robjects.tab "R Objects">
+<!ENTITY sciviews.robjects.tip "Explorateur d'objets R">
+<!ENTITY sciviews.robjects.refresh "RŽactualiser">
+<!ENTITY sciviews.robjects.refresh.tip "RŽactualiser les objets R">
+<!ENTITY sciviews.robjects.showHide "Chemin de recherche">
+<!ENTITY sciviews.robjects.showHide.tip "Montrer/cacher le chemin de recherche">
+<!ENTITY sciviews.robjects.filter.tip "Filtrer le nom des objets">
+<!ENTITY sciviews.robjects.Name "Nom">
+<!ENTITY sciviews.robjects.Dims "Dims">
+<!ENTITY sciviews.robjects.Group "Groupe">
+<!ENTITY sciviews.robjects.Class "Classe">
Added: komodo/SciViews-K/sciviewsk-0.6.0-ko.xpi
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/sciviewsk-0.6.0-ko.xpi
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/array.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/array.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/body_bg_sav.gif
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/body_bg_sav.gif
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/character.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/character.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/data.frame.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/data.frame.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/dist.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/dist.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/factor.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/factor.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/function.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/function.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/integer.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/integer.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/list.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/list.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/logical.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/logical.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/matrix.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/matrix.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/numeric.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/numeric.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/objects.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/objects.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/package.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/package.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/images/ts.png
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/skin/images/ts.png
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/skin/sciviewsk.css
===================================================================
--- komodo/SciViews-K/skin/sciviewsk.css (rev 0)
+++ komodo/SciViews-K/skin/sciviewsk.css 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,24 @@
+.searchPath-icon{
+ list-style-image: url("chrome://komodo/skin/images/bulletlist.png");
+}
+.searchPath-icon:hover{
+ list-style-image : url("chrome://komodo/skin/images/bulletlist_hover.png");
+}
+
+.refresh-icon{
+ list-style-image: url("chrome://komodo/skin/global/images/refresh.png");
+}
+treechildren::-moz-tree-cell-text(package) { font-weight: bold; }
+treechildren::-moz-tree-image(package){ list-style-image: url("chrome://sciviewsk/skin/images/package.png"); }
+treechildren::-moz-tree-image(matrix){ list-style-image: url("chrome://sciviewsk/skin/images/matrix.png"); }
+treechildren::-moz-tree-image(array){ list-style-image: url("chrome://sciviewsk/skin/images/array.png"); }
+treechildren::-moz-tree-image(character){ list-style-image: url("chrome://sciviewsk/skin/images/character.png"); }
+treechildren::-moz-tree-image(data-frame){ list-style-image: url("chrome://sciviewsk/skin/images/data.frame.png"); }
+treechildren::-moz-tree-image(numeric){ list-style-image: url("chrome://sciviewsk/skin/images/numeric.png"); }
+treechildren::-moz-tree-image(integer){ list-style-image: url("chrome://sciviewsk/skin/images/integer.png"); }
+treechildren::-moz-tree-image(dist){ list-style-image: url("chrome://sciviewsk/skin/images/dist.png"); }
+treechildren::-moz-tree-image(ts){ list-style-image: url("chrome://sciviewsk/skin/images/ts.png"); }
+treechildren::-moz-tree-image(function){ list-style-image: url("chrome://sciviewsk/skin/images/function.png"); }
+treechildren::-moz-tree-image(list){ list-style-image: url("chrome://sciviewsk/skin/images/list.png"); }
+treechildren::-moz-tree-image(factor){ list-style-image: url("chrome://sciviewsk/skin/images/factor.png"); }
+treechildren::-moz-tree-image(logical){ list-style-image: url("chrome://sciviewsk/skin/images/logical.png"); }
Added: komodo/SciViews-K/templates/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/templates/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/templates/All Languages/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/templates/All Languages/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/templates/All Languages/R.R
===================================================================
Added: komodo/SciViews-K/templates/Common/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/templates/Common/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K/templates/Common/R S3 object.R
===================================================================
--- komodo/SciViews-K/templates/Common/R S3 object.R (rev 0)
+++ komodo/SciViews-K/templates/Common/R S3 object.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,40 @@
+# S3 object: [[%ask1:Class]]
+# Author: [[%ask:Author]]
+
+# Creator or the S3 object (usually, a function with the same name)
+"[[%ask1]]"
+<- function() {
+ # Code to create the object here...
+ obj <- "[[%ask1]] object"
+ class(obj) <- [[%ask1]]
+ return(obj)
+
+}
+
+# Print method
+"print.[[%ask1]]"
+<- function(x, ...) {
+ # Code to print the object here...
+ cat ("[[%ask1]] object printed\n")
+ return(invisible(x))
+}
+
+# Summary method
+"summary.[[%ask1]]" <-
+function(object, ...)
+ structure(object, class = c("summary.[[%ask1]]", class(object)))
+
+"print.summary.[[%ask1]]" <-
+function(x, ...) {
+ # Code to print the summary of the object here...
+ cat ("[[%ask1]] object summarized\n")
+ return(invisible(x))
+}
+
+# Plot method
+"plot.[[%ask1]]"
+<- function(x, ...) {
+ # Code to plot the object here...
+ cat ("[[%ask1]] object plotted\n")
+ invisible()
+}
\ No newline at end of file
Added: komodo/SciViews-K/templates/Common/R.R
===================================================================
Added: komodo/SciViews-K/toolbox/SciViews-K 0.6.0.kpz
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K/toolbox/SciViews-K 0.6.0.kpz
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K Unit/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K Unit/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K Unit/SciViews-K Unit.kpf
===================================================================
--- komodo/SciViews-K Unit/SciViews-K Unit.kpf (rev 0)
+++ komodo/SciViews-K Unit/SciViews-K Unit.kpf 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,283 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!-- Komodo Project File - DO NOT EDIT -->
+<project id="5434d89d-0d44-ff4a-a625-44da4954f8fc" kpf_version="4" name="SciViews-K Unit.kpf">
+<folder id="83d0643f-3826-d844-9c15-d9b56bcd3359" idref="5434d89d-0d44-ff4a-a625-44da4954f8fc" name="Project">
+</folder>
+<macro async="0" icon="chrome://famfamfamsilk/skin/icons/brick.png" id="00a422ad-498a-db4f-8807-1dd82ba5713e" idref="83d0643f-3826-d844-9c15-d9b56bcd3359" keyboard_shortcut="" language="JavaScript" name="extension_lib" rank="100" trigger="trigger_postopen" trigger_enabled="0">
+try {
+
+var extensionLib = function() {
+ this.os = Components.classes['@activestate.com/koOs;1'].
+ getService(Components.interfaces.koIOs);
+ this.error = false;
+}
+
+extensionLib.prototype.getPath = function(relative) {
+ try {
+ var prj_path = ko.interpolate.interpolateStrings('%p');
+ path = this.os.path.join(prj_path, relative);
+ return path;
+ } catch(e) {
+ alert(e+"\narg name: "+name);
+ }
+}
+
+extensionLib.prototype.readFile = function(filename) {
+ // read the template file
+ try {
+ var fileEx = Components.classes["@activestate.com/koFileEx;1"]
+ .createInstance(Components.interfaces.koIFileEx);
+ fileEx.URI = filename;
+ fileEx.open('rb');
+ var content = fileEx.readfile();
+ fileEx.close();
+ return content;
+ } catch(e) {
+ alert(e+"\narg filename: "+filename);
+ }
+}
+
+extensionLib.prototype.writeFile = function(filename, content) {
+ try {
+ var fileEx = Components.classes["@activestate.com/koFileEx;1"]
+ .createInstance(Components.interfaces.koIFileEx);
+ fileEx.URI = filename;
+ fileEx.open('wb+');
+ fileEx.puts(content);
+ fileEx.close();
+ } catch(e) {
+ alert(e+"\narg filename: "+filename);
+ }
+}
+
+extensionLib.prototype.getRdfVars = function(txt) {
+ try {
+ var Rx = /\<em\:([\w]+)[\ \S]*\>([\S\ ]+?)\<\//g;
+ var ext_vars = {};
+ while(results = Rx.exec(txt)) {
+ var idRx = /type|min|max|\{/;
+ if(!idRx.test(results[0])) { // filter out stuff we don't want
+ ext_vars[results[1]] = results[2];
+ }
+ }
+ return ext_vars;
+ } catch(e) {
+ alert(e+"\narg rdf_path: "+rdf_path);
+ }
+}
+
+extensionLib.prototype.getManifestVars = function(txt) {
+ try {
+ var rx1 = /content ([\S]+?) jar\:([\S]+?)\.jar/g;
+ var res1 = rx1.exec(txt);
+ var rx2 = /chrome:\/\/([\S]+?)\/content\/overlay\.xul/g;
+ var res2 = rx2.exec(txt);
+ return new Array(res1[1], res1[2], res2[1]);
+ } catch(e) {
+ alert(e+"\narg path: "+path);
+ }
+}
+
+extensionLib.prototype.getOverlayVars = function(txt) {
+ try {
+ var rx1 = /<overlay id="([\S]+?)"/g;
+ var res1 = rx1.exec(txt);
+ var rx2 = /<menuitem id="([\S]+?)"[\s]+?label="([\S\ ]+?)"/g;
+ var res2 = rx2.exec(txt);
+ return [res1[1], res2[1], res2[2]];
+ } catch(e) {
+ alert(e+"\narg path: "+path);
+ }
+}
+
+extensionLib.prototype.updateProject = function(vars) {
+ try {
+ var overlayPath = this.getPath('content/overlay.xul');
+ if(this.os.path.exists(overlayPath)) {
+ var ovl_str = this.readFile(overlayPath);
+ var ov_vars = this.getOverlayVars(ovl_str);
+ var ovl_new = [vars.ext_name+'Overlay', 'menu_'+vars.ext_name, vars.name];
+ this.writeFile(overlayPath, this.replaceAll(ov_vars, ovl_new, ovl_str));
+ } else { this.error = "Doesn't exist: "+overlayPath; return false; }
+
+ var manifestPath = this.getPath('chrome.manifest');
+ if(this.os.path.exists(manifestPath)) {
+ var man_str = this.readFile(manifestPath);
+ var man_vars = this.getManifestVars(man_str);
+ var man_new = [vars.ext_name, vars.ext_name, vars.ext_name];
+ this.writeFile(manifestPath, this.replaceAll(man_vars, man_new, man_str));
+ } else { this.error = "Doesn't exist: "+overlayPath; return false; }
+
+ var rdf_path = this.getPath('install.rdf');
+ if(this.os.path.exists(rdf_path)) {
+ var rdf_str = this.readFile(rdf_path);
+ var rdf_vars = this.getRdfVars(rdf_str);
+ this.writeFile(rdf_path, this.replaceAll(rdf_vars, vars, rdf_str));
+ } else { this.error = "Doesn't exist: "+overlayPath; return false; }
+
+ } catch(e) {
+ this.error = e;
+ return false;
+ }
+ return true;
+}
+
+extensionLib.prototype.replaceAll = function(orig_vars, new_vars, str) {
+ try {
+ var out = str;
+ for(v in orig_vars) {
+ out = out.replace(orig_vars[v], new_vars[v]);
+ }
+ return out;
+ } catch(e) {
+ alert(e);
+ }
+}
+
+extensionLib.prototype.getNiceName = function(name) {
+ return this.trim(name).replace(/[\W]/g,'').toLowerCase();
+}
+
+extensionLib.prototype.trim = function(str) {
+ return str.replace(/^\s*/, '').replace(/\s*$/, '');
+}
+
+extensionLib.prototype.clone = function(obj) {
+ var newobj = {}; for(i in obj) {
+ newobj[i] = obj[i];
+ } return newobj;
+}
+
+extensionLib.prototype._dump = function(obj) {
+ var str = ''; for(i in obj) {
+ str += i+': '+obj[i]+'\n';
+ } return(str);
+}
+
+extensionLib.prototype._keys = function(obj) {
+ var out = new Array(); for(i in obj) {
+ out.push(i);
+ } return out;
+}
+
+} catch(e) {
+ allert(e);
+}
+</macro>
+<macro async="0" icon="chrome://famfamfamsilk/skin/icons/lightning_go.png" id="163bfade-9e58-9849-b2f9-90f6f6a4d017" idref="83d0643f-3826-d844-9c15-d9b56bcd3359" keyboard_shortcut="" language="JavaScript" name="Build" rank="100" trigger="trigger_postopen" trigger_enabled="0">
+/**
+ * Script to build an xpi, running koext build in the current project root.
+ */
+
+var project = ko.macros.current.project;
+
+var os = Components.classes['@activestate.com/koOs;1'].
+ getService(Components.interfaces.koIOs);
+
+var koSysUtils = Components.classes["@activestate.com/koSysUtils;1"].
+ getService(Components.interfaces.koISysUtils);
+
+var appInfo = Components.classes["@mozilla.org/xre/app-info;1"].
+ getService(Components.interfaces.nsIXULRuntime);
+
+var koDirs = Components.classes['@activestate.com/koDirs;1'].
+ getService(Components.interfaces.koIDirs);
+
+var pythonExe = koDirs.pythonExe;
+var projectDir = ko.interpolate.interpolateStrings('%p');
+var scriptName = 'koext';
+
+if (appInfo.OS == 'WINNT') {
+ scriptName += ".py";
+}
+
+var arr = [koDirs.sdkDir, 'bin', scriptName]
+var app = os.path.joinlist(arr.length, arr);
+var cmd = '"'+pythonExe+'" "'+app+'" build -d "'+projectDir+'"';
+
+if (appInfo.OS == 'WINNT') {
+ cmd = '"' + cmd + '"';
+}
+var cwd = koDirs.mozBinDir;
+cmd += " {'cwd': u'"+cwd+"'}";
+
+ko.run.runEncodedCommand(window, cmd, function() {
+ ko.statusBar.AddMessage('Build complete', 'projects', 5000, true);
+ ko.projects.manager.saveProject(project);
+});
+</macro>
+<macro async="0" icon="chrome://famfamfamsilk/skin/icons/wrench.png" id="641fcb73-4b02-a343-bb92-e6b80641a44f" idref="83d0643f-3826-d844-9c15-d9b56bcd3359" keyboard_shortcut="" language="JavaScript" name="Configure" rank="100" trigger="trigger_postopen" trigger_enabled="0">
+try {
+
+var libPart = ko.projects.findPart('macro', 'extension_lib', 'container');
+eval(libPart.value);
+
+var koExt = new extensionLib();
+
+var project = ko.macros.current.project;
+
+var setupWin = project.getChildByAttributeValue('name','setup.xul', 1);
+var rdf = project.getChildByAttributeValue('name','install.rdf', 1);
+var data = {};
+
+var prefset = project.prefset;
+
+if(prefset.hasPrefHere('configured')) {
+ var rdf_xml = koExt.readFile(rdf.getFile().URI);
+ data = {
+ 'valid': false,
+ 'configured': true,
+ 'vars': koExt.getRdfVars(rdf_xml)
+ };
+ data.vars['ext_name'] = koExt.getNiceName(data.vars.name);
+} else { // init data
+ data = {
+ 'valid': false,
+ 'configured': false,
+ 'vars': {
+ 'id': '',
+ 'name': 'My Extension',
+ 'creator': 'Me',
+ 'version': '0.1',
+ 'description': '',
+ 'homepageURL': '',
+ 'ext_name': ''
+ }
+ };
+}
+
+window.openDialog(
+ setupWin.getFile().URI,
+ "_blank",
+ "centerscreen,chrome,resizable,scrollbars,dialog=no,close,modal=yes",
+ data
+);
+
+if(data.valid) {
+ if(koExt.updateProject(data.vars)) {
+ prefset.setBooleanPref('configured', true);
+ var part = project.getChildByAttributeValue('name', 'oncreate',1);
+ if(part) { part.name = 'Configure'; }
+ var msg = 'Extension Project '+data.vars.name+' configured!';
+ ko.statusBar.AddMessage(msg, 'project', 3000, true);
+ ko.projects.manager.saveProject(project);
+ } else {
+ alert('Error encountered: '+koExt.error+"\nConfiguration aborted.");
+ }
+}
+
+} catch(e) {
+ alert(e);
+}
+</macro>
+<file id="8aa93793-645c-7f4a-90f0-57ccdcbfd449" idref="83d0643f-3826-d844-9c15-d9b56bcd3359" name="setup.xul" url="_prj_internal_/setup.xul">
+</file>
+<preference-set idref="5434d89d-0d44-ff4a-a625-44da4954f8fc">
+ <boolean id="configured">1</boolean>
+ <string id="import_exclude_matches">*.*~;*.bak;*.tmp;CVS;.#*;*.pyo;*.pyc;.svn;*%*;tmp*.html;.DS_Store;_prj_internal_</string>
+ <string id="import_include_matches"></string>
+ <boolean id="import_live">1</boolean>
+ <boolean id="import_recursive">1</boolean>
+ <string id="import_type">useFolders</string>
+</preference-set>
+</project>
Added: komodo/SciViews-K Unit/_prj_internal_/setup.xul
===================================================================
--- komodo/SciViews-K Unit/_prj_internal_/setup.xul (rev 0)
+++ komodo/SciViews-K Unit/_prj_internal_/setup.xul 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,167 @@
+<?xml version="1.0"?>
+<?xml-stylesheet href="chrome://global/skin/" type="text/css"?>
+<?xml-stylesheet href="chrome://komodo/skin/" type="text/css"?>
+
+<dialog
+ id="test"
+ title="Komodo Extension configuration"
+ xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul"
+ onload="setup()"
+ width="400px"
+ height="480px"
+ buttons="accept,cancel"
+ buttonlabelcancel="Cancel"
+ buttonlabelaccept="Save"
+ ondialogaccept="return teardown();"
+ ondialogcancel="return cancel();"
+ defaultButton="accept"
+ buttonalign="horizontal"
+ buttonorient="horizontal"
+ orient="vertical"
+ >
+
+<script type="application/x-javascript">
+<![CDATA[
+
+var data = {};
+var ext_name = '';
+
+function get_id(strId) { return document.getElementById(strId); }
+function get_val(strId) { return get_id(strId).value; }
+function set_val(strId, val) { get_id(strId).value = val; }
+function get_nice_name(name) { return trim(name).replace(/[\W]/g,'').toLowerCase(); }
+function trim(str) { return str.replace(/^\s*/, '').replace(/\s*$/, ''); }
+function _dump(obj) {
+ try{
+ var str = ''; for(i in obj) {
+ str += i+': '+obj[i]+'\n';
+ }
+ } catch(e) {alert(e);}
+ return str;
+}
+
+function setup() {
+ try {
+ if(typeof(window.arguments) == 'undefined') {
+ alert('Error: No Window arguments?');
+ } else {
+ data = window.arguments[0];
+ var vars = data.vars;
+ for(i in vars) {
+ if(i == 'id' || i == 'ext_name') {
+ //pass
+ } else {
+ set_val(i, vars[i]);
+ }
+ }
+ if(vars['id']) {
+ var arr = vars.id.split('@');
+ if(arr.length < 2) {
+ alert('Extension Id is not in the correct format?');
+ return;
+ }
+ set_val('author-domain', arr[1]);
+ }
+ update_id();
+ if(!data.vars['homepageUrl']) {
+ update_url();
+ }
+ }
+ } catch(e) { alert(e); }
+}
+
+function update_url() {
+ var domain = get_id('author-domain').value;
+ var ext_name = get_nice_name(get_val('name'));
+ set_val('homepageURL', 'http://'+domain+'/'+ext_name);
+}
+
+function update_id() {
+ try {
+ var name = get_val('name');
+ data.vars.ext_name = get_nice_name(name);
+
+ var domain = get_id('author-domain').value;
+ var newId = data.vars.ext_name+'@'+domain;
+
+ get_id('id').value = newId;
+ } catch(e) {
+ alert(e);
+ }
+}
+
+function teardown() {
+ try {
+ for(i in data.vars) {
+ if(i != 'ext_name') {
+ data.vars[i] = get_val(i);
+ }
+ }
+ data.vars.ext_name = get_nice_name(data.vars.name);
+ data.valid = true;
+ data.configured = true;
+ window.close();
+ } catch(e) {
+ alert(e);
+ }
+}
+
+function cancel() {
+ return confirm('Cancel Configuration?');
+}
+
+function keys(obj) {
+ var out = new Array(); for(i in obj) {
+ out.push(i);
+ } return out;
+}
+
+]]>
+</script>
+
+
+<commandset id="koext_commands">
+ <command id="update_id" oncommand="update_id();"/>
+</commandset>
+
+<vbox flex="1">
+ <caption label="Extension Options"/>
+ <grid flex="1">
+ <columns>
+ <column/>
+ <column flex="1"/>
+ </columns>
+ <rows>
+ <row align="center">
+ <label value="Name:"/>
+ <textbox id="name" type="timed" timeout="1000" command="update_id"/>
+ </row>
+ <row align="center">
+ <label value="Version:"/>
+ <textbox id="version"/>
+ </row>
+ <row align="top">
+ <label value="Description:"/>
+ <textbox id="description" multiline="true" value=""/>
+ </row>
+ <row align="center">
+ <label value="Author:"/>
+ <textbox id="creator" value=""/>
+ </row>
+ <row align="center">
+ <label value="Domain:"/>
+ <textbox id="author-domain" value="yourdomain.org" type="timed" timeout="1000" command="update_id"/>
+ </row>
+ <row align="center">
+ <label value="Home Page:"/>
+ <textbox id="homepageURL" value=""/>
+ </row>
+ <row align="center">
+ <label value="Extension Id:"/>
+ <label style="font-weight: bolder;" id="id"/>
+ </row>
+ </rows>
+ </grid>
+</vbox>
+
+</dialog>
Added: komodo/SciViews-K Unit/chrome.manifest
===================================================================
--- komodo/SciViews-K Unit/chrome.manifest (rev 0)
+++ komodo/SciViews-K Unit/chrome.manifest 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,7 @@
+content sciviewskunit jar:sciviewskunit.jar!/content/ xpcnativewrappers=yes
+overlay chrome://komodo/content/komodo.xul chrome://sciviewskunit/content/overlay.xul
+
+locale sciviewskunit en-GB jar:sciviewskunit.jar!/locale/en-GB/
+locale sciviewskunit fr-FR jar:sciviewskunit.jar!/locale/fr-FR/
+
+skin sciviewskunit classic/1.0 jar:sciviewskunit.jar!/skin/
\ No newline at end of file
Added: komodo/SciViews-K Unit/content/js/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K Unit/content/js/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K Unit/content/js/sciviewskunit.js
===================================================================
--- komodo/SciViews-K Unit/content/js/sciviewskunit.js (rev 0)
+++ komodo/SciViews-K Unit/content/js/sciviewskunit.js 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,706 @@
+// SciViews-K R unit functions
+// Define the 'sv.r.unit' namespace
+// Copyright (c) 2008, Philippe Grosjean
+
+////////////////////////////////////////////////////////////////////////////////
+// sv.r.unit.version // Version of the svUnit R package it was designed for
+// sv.r.unit.release; // The release (bug fixes). Full version is "version.release"
+//
+// sv.r.unit.getRUnitList(); // Get the list of available units
+// sv.r.unit.showRUnitList(); // Show/hide the unit list
+// sv.r.unit.setAutoTest(state); // Change autoTest on/off
+// sv.r.unit.isAutoTest(); // Is it currently in autoTest mode?
+// sv.r.unit.autoTest(); // autoTest on/off, not supposed to be called directly
+// sv.r.unit.runTest(); // Run the R test suite
+// sv.r.unit.runTest_feedback(data); // Feedback during run of the R test suite
+// sv.r.unit.runTest_finished(data); // The test suite is done in R
+// sv.r.unit.showRUnitPane(); // Show the R Unit pane
+// sv.r.unit.jumpToObject(event); // Go to the corresponding object (user event)
+// sv.r.unit.fillInTooltip(event); // Change the tooltip content (user event)
+//
+////////////////////////////////////////////////////////////////////////////////
+//
+// TODO:
+// * Modify FileObserver to use run tests only if a R file changes (or even only
+// if R code is loaded in R, or a R package is installed!)
+// * In AutoMode, also trigger test units when something is submitted to R
+// * Allow for progression indication using sv.r.runTest_feedback()
+// * Bug: arrows in the tree do not change their orientation when nodes are
+// opened or closed
+// * Autoinstallation of the -ko.xpi and version checking when the svUnit R
+// package is loaded in R
+// * Finalize localization
+//
+////////////////////////////////////////////////////////////////////////////////
+
+// Make sure that 'sv.r' is defined, i.e., the SciViews-K extension is loaded
+if (typeof(sv.r) == 'undefined') {
+ alert("You must install the SciViews-K extension to use SciViews-K Unit! Visit http://www.sciviews.org/SciViews-K to download it.")
+} else {
+
+// Define the 'sv.r.unit' namespace
+if (typeof(sv.r.unit) == 'undefined') sv.r.unit = {
+ version: 0.6,
+ release: 0,
+ debug: true
+};
+
+(function() { // 'sv.r.unit' namespace inside closure
+
+ var DEACTIVATED = 0;
+ var PASS = 1;
+ var FAIL = 2;
+ var ERROR = 3;
+
+ var CELLTEXT = 0;
+ var LEVEL = 1;
+ var ERRORTYPE = 2;
+ var ERRORTEXT = 3;
+ var OPEN = 4;
+ var PARENT = 5;
+ var ID = 6;
+ var URI = 7;
+
+ var gUnitTestRunning = false;
+ var gUnitTreeObject = null;
+ var gFileObserver = new _FileObserver();
+ var gPrefSvc = Components.classes["@activestate.com/koPrefService;1"].
+ getService(Components.interfaces.koIPrefService);
+
+ var gUnitList = [];
+ var gOldUnitList = [];
+ var gUnitListSelected = [];
+
+ this.showRUnitList = function() {
+ var splitter = document.getElementById("svunit_splitter");
+ var state = splitter.getAttribute("state");
+ if (state == "collapsed") {
+ state = "open";
+ this.getRUnitList();
+ } else {
+ state = "collapsed";
+ }
+ splitter.setAttribute("state", state);
+ }
+
+ this.getRUnitList = function() {
+ // TODO: a more sophisticated process looking (1) if svUnit R package
+ // is installed, and (2) if its version is correct. If not, propose to
+ // install or update it!
+ sv.r.evalHidden('require(svUnit, quietly = TRUE)', false); // Make sure svUnit is loaded
+ var cmd = 'cat(guiSuiteList(sep = ",", compare = FALSE))';
+ sv.r.evalCallback(cmd, sv.r.unit.getRUnitList_Callback);
+ }
+
+ this.getRUnitList_Callback = function(data) {
+ gUnitList = [];
+ if (data != "")
+ gUnitList = data.replace(/[\n\r]/g, "").split(/,/);
+ // Add unit tests in currently edited packages
+ // TODO: add items from all opened projects, not just active one
+ var numfiles = new Object();
+ var projfiles = new Array();
+ var project = ko.projects.manager.getCurrentProject();
+ if (project != null) {
+ project.getAllContainedURLs(projfiles, numfiles);
+ var files = projfiles.value;
+ for (var i=0; i<numfiles.value; i++) {
+ if (files[i].slice(0, 4) == "runit" &&
+ (files[i].slice(-2) == '.r' ||
+ files[i].slice(-2) == '.R'))
+ gUnitList.push("dir:" + files[i]);
+ }
+ }
+ // Display the unit list
+ var unit;
+ var node = document.getElementById("svunit_unitlist_listbox");
+ sv.tools.e4x2dom.clear(node);
+ var item;
+ var k = 0;
+ var checked = "false";
+ for(var i = 0; i < gUnitList.length; i++) {
+ unit = gUnitList[i];
+ if (isSelected(unit)) {
+ ischecked = "true";
+ if (!isInOldList(unit))
+ gOldUnitList[gOldUnitList.length] = unit; // Add it
+ } else if (isInOldList(unit)) {
+ ischecked = "false";
+ } else { // New items are automatically added to selected items
+ ischecked = "true";
+ gUnitListSelected[gUnitListSelected.length] = unit;
+ gOldUnitList[gOldUnitList.length] = unit;
+ }
+ item =
+ <listitem type="checkbox" label={unit} checked={ischecked}
+ onclick="sv.r.unit.unitSelect(event);"
+ spid={unit}
+ />;
+ sv.tools.e4x2dom.append(item, node, k);
+ k++;
+ }
+ }
+
+ this.unitSelect = function(event) {
+ var cb = event.target;
+ var status = cb.checked;
+ var unit = cb.getAttribute("spid");
+ if (status) {
+ if (!isSelected(unit)) {
+ gUnitListSelected[gUnitListSelected.length] = unit;
+ }
+ } else {
+ if (isSelected(unit)) {
+ sv.tools.array.remove(gUnitListSelected, unit);
+ }
+ }
+ }
+
+ function isSelected(unit) {
+ return(sv.tools.array.contains(gUnitListSelected, unit));
+ }
+
+ function isInOldList(unit) {
+ return(sv.tools.array.contains(gOldUnitList, unit));
+ }
+
+ this.setAutoTest = function(state) {
+ var autoTestButton = document.getElementById('svunit-auto-tests-button');
+ if (autoTestButton.checked != state) {
+ autoTestButton.checked = state;
+ this.autoTest();
+ }
+ }
+
+ this.isAutoTest = function() {
+ var autoTestButton = document.getElementById('svunit-auto-tests-button');
+ return(autoTestButton.checked);
+ }
+
+ this.autoTest = function() {
+ try {
+ var autoTestButton = document.getElementById('svunit-auto-tests-button');
+ var runTestsButton = document.getElementById('svunit-run-tests-button');
+ //runTestsButton.disabled = autoTestButton.checked;
+ if (autoTestButton.checked) {
+ gUnitTestRunning = false; // Reset testing flag TODO: what if test is running?
+ gFileObserver.addObserver();
+ this.runTest();
+ } else {
+ gFileObserver.removeObserver();
+ }
+ gPrefSvc.prefs.setBooleanPref("svunitAutoTest", autoTestButton.checked);
+ } catch (e) {
+ alert(e);
+ }
+ }
+
+ this.runTest = function () {
+ if (!gUnitTestRunning) {
+ try {
+ // Determine, among select test, which one are in the current list
+ var Selected = [];
+ k = 0;
+ for (var i = 0; i < gUnitList.length; i++) {
+ if (sv.tools.array.contains(gUnitListSelected, gUnitList[i])) {
+ Selected[k] = gUnitList[i];
+ k += 1;
+ }
+ }
+ if (Selected.length == 0) {
+ // If not autotest, issue a warning
+ ko.statusBar.AddMessage("No test selected. Do '?svUnit' in R to learn how to create tests...", "svUnit", 2000, true);
+ return;
+ }
+ // Start running the tests
+ gUnitTestRunning = true;
+ // Update the GUI
+ var pass_label = document.getElementById('svunit-pass-label');
+ pass_label.value = "Pass: -"
+ var fail_label = document.getElementById('svunit-fail-label');
+ fail_label.value = "Fail: -"
+ var error_label = document.getElementById('svunit-error-label');
+ error_label.value = "Errors: -"
+ var deact_img = document.getElementById('svunit-deactivated-image');
+ deact_img.setAttribute("tooltiptext", "");
+ deact_img.src = "";
+ var statusbar_pane = document.getElementById('statusbar-svunit');
+ statusbar_pane.src = "chrome://famfamfamsilk/skin/icons/hourglass.png";
+ statusbar_pane.setAttribute("tooltiptext", "R Unit Status: running");
+ var progressbar = document.getElementById('svunit-progress-bar');
+ progressbar.style.backgroundColor = "#E6E6E6";
+ // Collect together selected tests and run them
+ var cmd = 'require(svUnit, quietly = TRUE); createLog(deleteExisting = TRUE); runTest(svSuite(c("'
+ cmd = cmd + Selected.join('", "')
+ cmd = cmd + '")), name = "objects"); cat(guiTestReport(Log()))'
+// if (this.debug) alert("'" + cmd + "'");
+ var res = sv.r.evalCallback(cmd, sv.r.unit.runTest_finished);
+ ko.statusBar.AddMessage("R unit test started", "svUnit", 1000, true);
+ } catch(e) {
+ alert(e);
+ }
+ }
+ }
+
+ this.runTest_feedback = function(data) {
+ gUnitTestRunning = true;
+ // TODO: provide feedback about tests execution
+ }
+
+ this.runTest_finished = function(data) {
+ try {
+ ko.statusBar.AddMessage("", "svUnit");
+ gUnitTestRunning = false;
+
+ if (this.debug) { // For debugging purposes
+ gUnitData = data;
+ }
+
+ if (sv.tools.strings.removeLastCRLF(data) != "" &&
+ gUnitTreeObject) {
+ var items = data.split("\t");
+ var item = [];
+ var tests = [];
+ var nPass = 0;
+ var nFail = 0;
+ var nError = 0;
+ var nDeactivated = 0;
+ var k = 0;
+ for (var i = 0; i < items.length; i++) {
+ item = items[i].split("|||")
+ // svUnit items start with '<<<svUnit'
+ if (item[0] == "<<<svUnitSummary>>>") {
+ nPass = item[1];
+ nFail = item[2];
+ nError = item[3];
+ nDeactivated = item[4];
+ } else if (item[0] == "<<<svUnitFile>>>") {
+ // TODO: create a new file node
+ } else if (item[0] == "<<<svUnitTest>>>") {
+ tests[k] = item;
+ k += 1;
+ }
+ }
+ // Update the tree
+ gUnitTreeObject.UnitTreeView.loadTests(tests);
+ // Update the GUI
+ var pass_label = document.getElementById('svunit-pass-label');
+ pass_label.value = "Pass: " + nPass
+ var fail_label = document.getElementById('svunit-fail-label');
+ fail_label.value = "Fail: " + nFail
+ var error_label = document.getElementById('svunit-error-label');
+ error_label.value = "Errors: " + nError
+ var deact_img = document.getElementById('svunit-deactivated-image');
+ if (nDeactivated == 0) {
+ deact_img.setAttribute("tooltiptext", "");
+ deact_img.src = "";
+ } else if (nDeactivated == 1) {
+ deact_img.setAttribute("tooltiptext", "Warning: " +
+ nDeactivated + " test is deactivated!");
+ deact_img.src = "chrome://famfamfamsilk/skin/icons/help.png";
+ } else {
+ deact_img.setAttribute("tooltiptext", "Warning: " +
+ nDeactivated + " tests are deactivated!");
+ deact_img.src = "chrome://famfamfamsilk/skin/icons/help.png";
+ }
+ // Update bar in test pane
+ var progressbar = document.getElementById('svunit-progress-bar');
+ if (nFail > 0 || nError > 0)
+ progressbar.style.backgroundColor = "#C00000";
+ else
+ progressbar.style.backgroundColor = "#008000";
+ // update icon in statusbar
+ var statusbar_pane = document.getElementById('statusbar-svunit');
+ if (nError > 0) {
+ statusbar_pane.src = "chrome://famfamfamsilk/skin/icons/delete.png";
+ statusbar_pane.setAttribute("tooltiptext", "R Unit Status: error (" + nError + ")");
+ } else if (nFail > 0) {
+ statusbar_pane.src = "chrome://famfamfamsilk/skin/icons/error.png";
+ statusbar_pane.setAttribute("tooltiptext", "R Unit Status: fail (" + nFail + ")");
+ } else {
+ statusbar_pane.src = "chrome://famfamfamsilk/skin/icons/accept.png";
+ statusbar_pane.setAttribute("tooltiptext", "R Unit Status: ok");
+ }
+ }
+ } catch(e) {
+ alert(e);
+ }
+ }
+
+ this.showRUnitPane = function(state) {
+ if (state == null) {
+ // Toggle RUnit pane
+ ko.uilayout.togglePane('workspace_right_splitter',
+ 'right_toolbox_tabs', 'cmd_viewRightPane');
+ if (ko.uilayout.isPaneShown(document.getElementById('right_toolbox_tabs'))) {
+ // Make the R Unit tab the current tab that is shown
+ ko.uilayout.ensureTabShown("sciviews_svunit_tab", false);
+ }
+ } else if (state == true) {
+ // Make sure the R Unit tab is displayed
+ ko.uilayout.ensureTabShown("sciviews_svunit_tab", false);
+ } else {
+ if (ko.uilayout.isPaneShown(document.getElementById('right_toolbox_tabs'))) {
+ // Hide the R Unit tab
+ ko.uilayout.togglePane('workspace_right_splitter',
+ 'right_toolbox_tabs', 'cmd_viewRightPane');
+ }
+ }
+ }
+
+ function getRowForEvent(event) {
+ var row = new Object();
+ var colId = new Object();
+ var child = new Object();
+ var tree = document.getElementById('svunit_tree');
+ var boxObject = tree.boxObject;
+ boxObject.QueryInterface(Components.interfaces.nsITreeBoxObject);
+ boxObject.getCellAt(event.clientX, event.clientY, row, colId, child);
+ return row.value;
+ }
+
+ this.jumpToObject = function(event) {
+ try {
+ var row = getRowForEvent(event);
+ var view = gUnitTreeObject.UnitTreeView;
+ if (!view.rows[row] ||
+ view.getChildren(row).length > 0) {
+ event.stopPropagation();
+ event.preventDefault();
+ event.cancelBubble = true;
+ }
+ if (view.rows[row][URI] && view.rows[row][URI] != ""
+ && view.getChildren(row).length == 0) {
+ var urilist = view.rows[row][URI].split("#");
+ // Look at urilist[1]: number => goto line, name => search for it
+ if (urilist[1]) {
+ if (parseInt(urilist[1]) > 0) { // Goto line...
+ gViewMgr.doFileOpenAtLine(urilist[0], urilist[1], 'editor');
+ } else { // Look for the function in the file
+ gViewMgr.doFileOpenAtLine(urilist[0], 1, 'editor');
+ var FindService = Components.classes['@activestate.com/koFindService;1'].
+ getService(Components.interfaces.koIFindService);
+ var FindContext = Components.classes['@activestate.com/koFindContext;1'].
+ createInstance(Components.interfaces.koIFindContext);
+ var FindSession = Components.classes['@activestate.com/koFindSession;1'].
+ getService(Components.interfaces.koIFindSession);
+ var FindOptions = FindService.options;
+ FindContext.type = FindOptions.preferredContextType;
+ FindOptions.patternType = FindOptions.FOT_REGEX_PYTHON;
+ FindOptions.searchBackward = false;
+ var FindPattern = urilist[1].replace(/[\n\r]/g, "") + '("|\'|`)?\\s*(<-|=)';
+ Find_FindNext(window, FindContext, FindPattern,
+ 'find', true, false);
+ }
+ } else {
+ gViewMgr.doFileOpen(urilist[0].replace(/[\n\r]/g, ""), 'editor');
+ }
+ var kv = ko.views.manager.currentView;
+ kv.setFocus();
+ kv.scimoz.homeDisplay();
+ }
+ }
+ catch (e) {
+ alert(e);
+ }
+ }
+
+ function fillInTooltip(event) {
+ try {
+ var row = getRowForEvent(event);
+ var tip = document.getElementById('svunit-tooltip');
+ var tree = document.getElementById('svunit_tree');
+ var view = gUnitTreeObject.UnitTreeView;
+ if (!view.rows[row] || view.getChildren(row).length > 0) {
+ event.stopPropagation();
+ event.preventDefault();
+ event.cancelBubble = true;
+ return false;
+ }
+ var etext = view.rows[row][ERRORTEXT];
+ var elist = etext.split('\n');
+ var textholder = document.getElementById('svunit-tooltip-container');
+ while (textholder.hasChildNodes())
+ textholder.removeChild(textholder.firstChild);
+ for (var i=0; i<elist.length; i++) {
+ var descriptionNode = document.createElement("description");
+ var linetext = document.createTextNode(elist[i]);
+ descriptionNode.appendChild(linetext);
+ textholder.appendChild(descriptionNode);
+ }
+ tip.setAttribute('style','height: 0px');
+ tip.showPopup(tree,event.clientX,event.clientY,
+ 'tooltip',"topleft","topleft");
+ var box = document.getBoxObjectFor(textholder);
+ tip.setAttribute('style','height: '+ box.height + 'px');
+ } catch (e) {
+ alert(e);
+ return false;
+ }
+ return true;
+ }
+
+ // File observer used to trigger tests of file/project changed
+ function _FileObserver() {
+ this.obsSvc = Components.classes["@mozilla.org/observer-service;1"].
+ getService(Components.interfaces.nsIObserverService);
+ this.added = false;
+ }
+
+ _FileObserver.prototype.constructor = _FileObserver;
+
+ _FileObserver.prototype.addObserver = function() {
+ if (!this.added) {
+ this.obsSvc.addObserver(this, "file_changed", false);
+ // this.obsSvc.addObserver(this, "file_project", false);
+ // this.obsSvc.addObserver(this, "current_project_changed", false);
+ this.added = true;
+ }
+ }
+
+ _FileObserver.prototype.removeObserver = function() {
+ if (this.added) {
+ this.obsSvc.removeObserver(this, "file_changed");
+ // this.obsSvc.removeObserver(this, "file_project");
+ // this.obsSvc.removeObserver(this, "current_project_changed");
+ this.added = false;
+ }
+ }
+
+ _FileObserver.prototype.finalize = function() {
+ this.removeObserver();
+ }
+
+ _FileObserver.prototype.observe = function(subject, topic, data) {
+ try {
+ if (topic == "file_changed") {
+ // If an R source file is changed; if auto mode, source it...
+ if (data.substr(-2, 2).toUpperCase() == ".R" &
+ sv.r.unit.isAutoTest()) {
+ // If data starts with "file://", eliminate this
+ if (data.substr(0, 7) == "file://")
+ data = data.substr(7);
+ sv.r.eval('source("' + data + '")');
+ // ... then, run the selected test
+ sv.r.unit.runTest();
+ }
+ }
+ } catch(e){
+ alert(e);
+ }
+ }
+
+ // Custom tree view for displaying tests performed by svUnit
+ function _UnitTreeView() {
+ this._debug = 0;
+ this._showHidden = false;
+ this.rows = [];
+ this.testItems = [];
+ }
+
+ _UnitTreeView.prototype = {
+ // The nsITreeView object for the tree view
+ getCellText : function(row, column) {
+ return this.rows[row][CELLTEXT];
+ },
+ get rowCount() { return this.rows.length; },
+
+ // Everything below here is just to satisfy the interface, and not all
+ // of it may be required
+ tree : null,
+ getLevel: function(row) {
+ return this.rows[row][LEVEL];
+ },
+ setTree : function(out) { this.tree = out; },
+ getRowProperties : function(row,prop) {},
+ getColumnProperties : function(column,prop){},
+ getCellProperties : function(row,column,props) {},
+ cycleCell: function(row, colId) {},
+ selectionChanged : function() {},
+ performAction : function(action) {},
+ isSorted : function() { return false; },
+ getImageSrc : function(row, col) {
+ var errorType = parseInt(this.rows[row][ERRORTYPE]);
+ if (errorType == PASS)
+ return "chrome://famfamfamsilk/skin/icons/bullet_green.png";
+ else if (errorType == FAIL)
+ return "chrome://famfamfamsilk/skin/icons/bullet_error.png";
+ else if (errorType == ERROR)
+ return "chrome://famfamfamsilk/skin/icons/bullet_delete.png";
+ else if (errorType == DEACTIVATED)
+ return "chrome://famfamfamsilk/skin/icons/bullet_white.png";
+ return null;
+ },
+ cycleHeader : function() {},
+ isSeparator : function(row) { return false; },
+
+ // Multi level tree functions
+ getParentIndex: function(row) {
+ return this.rows[row][PARENT];
+ },
+ isContainer : function(row) { return this.getChildren(row).length > 0; },
+ isContainerOpen: function(row) { return this.rows[row][OPEN]; },
+ isContainerEmpty: function(row) { return false; },
+
+ hasNextSibling: function(row, after) {
+ var level = this.getLevel(row);
+ // March on!
+ var l;
+ while (++row < this.rows.length) {
+ l = this.getLevel(row);
+ if (l < level)
+ return false;
+ else if (l == level && row > after)
+ return true;
+ }
+ return false;
+ },
+ toggleOpenState: function(row) {
+ window.setCursor("wait");
+ try {
+ var rowItem = this.rows[row];
+ if (rowItem[OPEN]) {
+ // close subtree
+ rowItem[OPEN] = false;
+
+ var thisLevel = rowItem[LEVEL];
+ var deletecount = 0;
+ for (var t = row + 1; t < this.rows.length; t++) {
+ if (this.getLevel(t) > thisLevel)
+ deletecount++;
+ else
+ break;
+ }
+ if (deletecount) {
+ this.rows.splice(row + 1, deletecount);
+ this.tree.rowCountChanged(row + 1, -deletecount);
+ }
+ } else {
+ // open subtree
+ rowItem[OPEN] = true;
+ var entries = this.getChildren(row);
+ var nodecount = 0;
+ for (var i = 0; i < entries.length; i++) {
+ child = entries[i];
+ this.rows.splice(row + nodecount + 1, 0, child);
+ nodecount += 1;
+ }
+ this.tree.rowCountChanged(row + 1, nodecount);
+ }
+ } catch (e) {
+ alert(e);
+ }
+ window.setCursor("auto");
+ }
+ }
+
+ _UnitTreeView.prototype.getChildren = function(row) {
+ var parentId = this.rows[row][ID];
+ var currLevel = this.rows[row][LEVEL];
+ var children = [];
+ for (var i=0; i<this._testItems.length; i++) {
+ var rowId = this._testItems[i][ID];
+ if (rowId == parentId) {
+ for (var j=i+1; j<this._testItems.length; j++) {
+ var rowItem = this._testItems[j];
+ if (rowItem[LEVEL] <= currLevel)
+ break;
+ children.push(rowItem);
+ }
+ break;
+ }
+ }
+ return children;
+ }
+
+ _UnitTreeView.prototype.loadTests = function(tests) {
+ try {
+ this.tree.rowCountChanged(0, -this.rows.length);
+ var new_rows = [];
+ var old_row = ['','',''];
+ var id = 0;
+ var k = 0;
+ var parentArray = [-1, 0, 1, 999]; // last value is unused
+ for (var i=0; i < tests.length; i++) {
+ var test = tests[i];
+ var subtree = test[1].split('>');
+ var errorType = parseInt(test[2]);
+ var errorText = test[3];
+ var URI = test[4];
+ var level = 0;
+ // Create a hierarchy in the test nodes (Unit > File > Function)
+ if (subtree[0] == old_row[0] && subtree[1] == old_row[1])
+ level = 2;
+ else if (subtree[0] == old_row[0])
+ level = 1;
+ for (k=level; k<subtree.length; k++) {
+ // nodetext, depth, errortype, errortext, open, parentIdx,
+ // id, linenum
+ new_rows.push([subtree[k], k, errorType, errorText, 1,
+ parentArray[k], id , URI]);
+ parentArray[k+1] = id;
+ id += 1;
+ }
+ var currParent = parentArray[subtree.length-1];
+ while (currParent != -1) {
+ if (new_rows[currParent][ERRORTYPE] < errorType)
+ new_rows[currParent][ERRORTYPE] = errorType;
+ currParent = new_rows[currParent][PARENT];
+ }
+ old_row = subtree;
+ }
+ this._testItems = new_rows.slice(0); // get a unique copy
+ this.rows = new_rows;
+ this._errors = errorText;
+
+ // Using rowCountChanged to notify rows were added
+ this.tree.rowCountChanged(0, this.rows.length);
+ } catch (e) {
+ alert(e);
+ }
+ }
+
+ function _UnitTree() {
+ try {
+ // Find some xul elements
+ // TODO: look in prefs if the unit list is visible or not and change
+ // its state accordingly
+ this.svunit_tree = document.getElementById("svunit_tree");
+ this.loadTree();
+ document.getElementById('svunit-tooltip').
+ addEventListener('popupshowing', fillInTooltip, true);
+ var autoTestSetting = true;
+ if (gPrefSvc.prefs.hasPref("svunitAutoTest"))
+ autoTestSetting = gPrefSvc.prefs.getBooleanPref("svunitAutoTest");
+ else
+ gPrefSvc.prefs.setBooleanPref("svunitAutoTest", autoTestSetting);
+ if (autoTestSetting == true) {
+ document.getElementById('svunit-auto-tests-button').checked = true;
+ } else {
+ document.getElementById('svunit-auto-tests-button').checked = false;
+ }
+ sv.r.unit.getRUnitList();
+ sv.r.unit.autoTest();
+ } catch (e) {
+ alert(e);
+ }
+ }
+
+ _UnitTree.prototype.loadTree = function() {
+ try {
+ this.UnitTreeView = new _UnitTreeView();
+ this.svunit_tree.treeBoxObject.view = this.UnitTreeView;
+ } catch (e) {
+ alert(e);
+ }
+ }
+
+ this.InitOverlay = function() {
+ gUnitTreeObject = new _UnitTree();
+ }
+
+}).apply(sv.r.unit);
+
+// Ensure we load the remote server information when the overlay is loaded
+addEventListener("load", sv.r.unit.InitOverlay, false);
+}
Property changes on: komodo/SciViews-K Unit/content/js/sciviewskunit.js
___________________________________________________________________
Name: svn:executable
+ *
Added: komodo/SciViews-K Unit/content/overlay.xul
===================================================================
--- komodo/SciViews-K Unit/content/overlay.xul (rev 0)
+++ komodo/SciViews-K Unit/content/overlay.xul 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,202 @@
+<?xml version="1.0"?>
+<!-- ***** BEGIN LICENSE BLOCK *****
+ License: GPL 2.0
+
+ The contents of this file are subject to the GNU General Public License
+ Version 2.0 (the "License")
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
+ License for the specific language governing rights and limitations
+ under the License.
+
+ SciViews-K is inspired from kNose by Brandon Corfman, distributed under a
+ triple MPL 1.1/GPL 2.0/LGPL 2.1 license, thus compatible with the License.
+
+ The Initial Developer of SciViews-K Unit is Philippe Grosjean
+ (phgrosjean at sciviews.org).
+ Portions created by ActiveState Software Inc are Copyright (C) 2000-2008
+ ActiveState Software Inc. All Rights Reserved.
+
+ Contributor(s):
+ Philippe Grosjean
+ Brandon Corfman
+ ActiveState Software Inc
+
+ ***** END LICENSE BLOCK ***** -->
+<!DOCTYPE overlay PUBLIC "-//MOZILLA//DTD XUL V1.0//EN" "http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul" [
+ <!ENTITY % sciviewskunitDTD SYSTEM "chrome://sciviewskunit/locale/sciviewskunit.dtd">
+ %sciviewskunitDTD;
+]>
+
+<?xml-stylesheet href="chrome://global/skin/global.css" type="text/css"?>
+<?xml-stylesheet href="chrome://komodo/skin/global/global.css" type="text/css"?>
+<?xml-stylesheet href="chrome://komodo/skin/bindings/buttons.css" type="text/css"?>
+<?xml-stylesheet href="chrome://sciviewskunit/skin/sciviewskunit.css" type="text/css"?>
+
+<overlay id="sciviewskunitOverlay"
+ xmlns:html="http://www.w3.org/1999/xhtml"
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul">
+
+ <script type="application/x-javascript" src="chrome://komodo/content/project/projectManager.js"/>
+ <script type="application/x-javascript" src="chrome://komodo/content/views.js"/>
+ <script type="application/x-javascript" src="chrome://komodo/content/library/open.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/sciviews.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/tools/strings.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/tools/e4x2dom.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/tools/array.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/socket.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewsk/content/js/r.js"/>
+ <script type="application/x-javascript" src="chrome://sciviewskunit/content/js/sciviewskunit.js"/>
+
+ <commandset id="allcommands">
+ <command id="Tasks:svUnitAbout"
+ oncommand="alert('SciViews-K Unit Tests for R, see http://www.sciviews.org/SciViews-K');"/>
+ </commandset>
+
+ <menupopup id="popup_tools">
+ <menuitem id="menu_sciviewsk"
+ label="SciViews-K Unit"
+ observes="Tasks:svUnitAbout"
+ class="menu-iconic-wide"/>
+ </menupopup>
+
+ <menupopup id="tabPicker_popup">
+ <menuitem id="show_svunit_tab"
+ insertafter="show_codebrowser_tab"
+ oncommand="uilayout_ensureTabShown('sciviews_svunit_tab', true)"
+ label="&sciviews.runit.tab;"/>
+ </menupopup>
+
+ <menupopup id="menu_view_tabs_popup">
+ <menuitem id="show_svunit_tab2"
+ insertafter="show_codebrowser_tab2"
+ class="menuitem-iconic-wide"
+ oncommand="uilayout_ensureTabShown('sciviews_svunit_tab', true)"
+ label="&sciviews.runit.tab;"/>
+ </menupopup>
+
+ <tabs id="right_toolbox_tabs">
+ <tab id="sciviews_svunit_tab"
+ label="&sciviews.runit.tab;"
+ insertafter="toolbox_tab"
+ tooltiptext="&sciviews.runit.tip;"/>
+ </tabs>
+
+ <tabpanels id="right_toolbox_tabpanels">
+ <tabpanel id="svunittreeviewbox"
+ flex="1"
+ insertafter="codebrowserviewbox">
+ <vbox id="svunittree-vbox"
+ flex="1">
+ <vbox flex="1">
+ <hbox id="svunittree-tabpanel-hbox"
+ align="center">
+ <toolbarbutton
+ id="svunit_refresh_button"
+ class="refresh-icon button-toolbar-a"
+ buttonstyle="pictures"
+ label="&sciviews.runit.refresh;"
+ tooltiptext="&sciviews.runit.refresh.tip;"
+ oncommand="sv.r.unit.getRUnitList();"/>
+ <toolbarbutton
+ id="svunit_unitlist_button"
+ class="searchPath-icon button-toolbar-a"
+ buttonstyle="pictures"
+ label="&sciviews.runit.showHide;"
+ tooltiptext="&sciviews.runit.showHide.tip;"
+ oncommand="sv.r.unit.showRUnitList();"/>
+ <checkbox
+ id="svunit-auto-tests-button"
+ label="&sciviews.runit.autoTest;"
+ tooltiptext="&sciviews.runit.autoTest.tip;"
+ checked="true"
+ oncommand="sv.r.unit.autoTest();"/>
+ <progressmeter
+ id="svunit-progress-bar"
+ mode="determined"
+ value="0%"/>
+ </hbox>
+ <vbox>
+ <listbox id="svunit_unitlist_listbox"
+ flex="1"/>
+ </vbox>
+ <splitter
+ id="svunit_splitter"
+ collapse="before"
+ resizeafter="farthest"
+ resizebefore="closest"
+ state="open">
+ <grippy tooltiptext="&sciviews.runit.showHide.tip;"/>
+ </splitter>
+ <hbox id="svunittree-tabpanel-hbox2"
+ align="center">
+ <toolbarbutton
+ id="svunit-run-tests-button"
+ image="chrome://famfamfamsilk/skin/icons/control_play_blue.png"
+ label="&sciviews.runit.run;"
+ tooltiptext="&sciviews.runit.run.tip;"
+ orient="horizontal"
+ disabled="false"
+ oncommand="sv.r.unit.runTest();"/>
+ <label
+ id="svunit-pass-label"
+ value="Pass: -"/>
+ <label
+ id="svunit-fail-label"
+ value="Fail: -"/>
+ <label
+ id="svunit-error-label"
+ value="Errors: -"/>
+ <image
+ id="svunit-deactivated-image"
+ tooltiptext=""
+ width="16"
+ src=""/>
+ </hbox>
+ <popupset id="svunitTooltipSet">
+ <popup
+ id="svunit-tooltip"
+ type="tooltip"
+ noautohide="true"
+ multiline="true">
+ <vbox id="svunit-tooltip-container"
+ align="left">
+ <description id="svunit-tooltip-desc"/>
+ </vbox>
+ </popup>
+ </popupset>
+ <tree id="svunit_tree"
+ flex="1"
+ seltype="single">
+ <treecols>
+ <treecol
+ id="tree_col_test_name"
+ label="&sciviews.runit.Name;"
+ primary="true"
+ flex="1"/>
+ </treecols>
+ <treechildren
+ tooltip="svunit-tooltip"
+ ondblclick="sv.r.unit.jumpToObject(event);"/>
+ </tree>
+ </vbox>
+ </vbox>
+ </tabpanel>
+ </tabpanels>
+
+ <statusbar
+ id="statusbarviewbox"
+ fullscreentoolbar="true"
+ orient="horizontal">
+ <statusbarpanel
+ id="statusbar-svunit"
+ class="statusbarpanel-iconic"
+ insertbefore="statusbar-check"
+ src="chrome://famfamfamsilk/skin/icons/help.png"
+ tooltiptext="R Unit Status: not run yet"
+ hidden="false"
+ onclick="sv.r.unit.showRUnitPane();"/>
+ </statusbar>
+</overlay>
Added: komodo/SciViews-K Unit/install.rdf
===================================================================
--- komodo/SciViews-K Unit/install.rdf (rev 0)
+++ komodo/SciViews-K Unit/install.rdf 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,30 @@
+<?xml version="1.0"?>
+<RDF xmlns="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+ xmlns:em="http://www.mozilla.org/2004/em-rdf#">
+ <Description about="urn:mozilla:install-manifest">
+ <em:id>sciviewskunit at sciviews.org</em:id>
+ <em:name>SciViews-K Unit</em:name>
+ <em:version>0.6.0</em:version>
+ <em:description>SciViews-K Unit - Interface to the svUnit R package</em:description>
+ <em:creator>Philippe Grosjean</em:creator>
+ <em:homepageURL>http://sciviews.org/SciViews-K</em:homepageURL>
+ <em:type>2</em:type> <!-- type=extension -->
+
+ <em:targetApplication>
+ <Description>
+ <!-- Komodo IDE's uuid -->
+ <em:id>{36E66FA0-F259-11D9-850E-000D935D3368}</em:id>
+ <em:minVersion>4.1</em:minVersion>
+ <em:maxVersion>4.4.*</em:maxVersion>
+ </Description>
+ </em:targetApplication>
+ <em:targetApplication>
+ <Description>
+ <!-- Komodo Edit's uuid -->
+ <em:id>{b1042fb5-9e9c-11db-b107-000d935d3368}</em:id>
+ <em:minVersion>4.1</em:minVersion>
+ <em:maxVersion>4.4.*</em:maxVersion>
+ </Description>
+ </em:targetApplication>
+ </Description>
+</RDF>
Added: komodo/SciViews-K Unit/locale/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K Unit/locale/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K Unit/locale/en-GB/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K Unit/locale/en-GB/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K Unit/locale/en-GB/sciviewskunit.dtd
===================================================================
--- komodo/SciViews-K Unit/locale/en-GB/sciviewskunit.dtd (rev 0)
+++ komodo/SciViews-K Unit/locale/en-GB/sciviewskunit.dtd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,11 @@
+<!ENTITY sciviews.runit.tab "R Unit">
+<!ENTITY sciviews.runit.tip "R unit tests">
+<!ENTITY sciviews.runit.refresh "Refresh">
+<!ENTITY sciviews.runit.refresh.tip "Refresh the unit list">
+<!ENTITY sciviews.runit.showHide "R Unit List">
+<!ENTITY sciviews.runit.showHide.tip "Show/hide the unit list">
+<!ENTITY sciviews.runit.autoTest "Auto">
+<!ENTITY sciviews.runit.autoTest.tip "Source code and run tests whenever a R file is saved">
+<!ENTITY sciviews.runit.run "Run">
+<!ENTITY sciviews.runit.run.tip "Run unit tests manually">
+<!ENTITY sciviews.runit.Name "Name">
Added: komodo/SciViews-K Unit/locale/fr-FR/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K Unit/locale/fr-FR/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K Unit/locale/fr-FR/sciviewskunit.dtd
===================================================================
--- komodo/SciViews-K Unit/locale/fr-FR/sciviewskunit.dtd (rev 0)
+++ komodo/SciViews-K Unit/locale/fr-FR/sciviewskunit.dtd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,11 @@
+<!ENTITY sciviews.runit.tab "R Unit">
+<!ENTITY sciviews.runit.tip "Tests unitŽ de R">
+<!ENTITY sciviews.runit.refresh "RŽactualiser">
+<!ENTITY sciviews.runit.refresh.tip "RŽactualiser le liste d'unitŽs">
+<!ENTITY sciviews.runit.showHide "Liste d'unitŽs R">
+<!ENTITY sciviews.runit.showHide.tip "Montrer/cacher la liste d'unitŽs">
+<!ENTITY sciviews.runit.autoTest "Auto">
+<!ENTITY sciviews.runit.autoTest.tip "Sourcer le code et lancer les tests ˆ chaque sauvegarde de fichier R">
+<!ENTITY sciviews.runit.run "Lancer">
+<!ENTITY sciviews.runit.run.tip "Lancer les tests manuellement">
+<!ENTITY sciviews.runit.Name "Nom">
Added: komodo/SciViews-K Unit/sciviewskunit-0.6.0-ko.xpi
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K Unit/sciviewskunit-0.6.0-ko.xpi
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K Unit/skin/.DS_Store
===================================================================
(Binary files differ)
Property changes on: komodo/SciViews-K Unit/skin/.DS_Store
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: komodo/SciViews-K Unit/skin/sciviewskunit.css
===================================================================
--- komodo/SciViews-K Unit/skin/sciviewskunit.css (rev 0)
+++ komodo/SciViews-K Unit/skin/sciviewskunit.css 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,10 @@
+#svunit-progress-bar
+{
+ -moz-appearance: none !important;
+ background-color: #E6E6E6;
+}
+
+toolbarbutton
+{
+ margin: 0px 2px;
+}
Property changes on: komodo/SciViews-K Unit/skin/sciviewskunit.css
___________________________________________________________________
Name: svn:executable
+ *
Added: komodo/TODO
===================================================================
--- komodo/TODO (rev 0)
+++ komodo/TODO 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,32 @@
+= SciViews-K To Do
+
+* Object explorer: refresh content, tooltip, menu, changer fonction refresh
+
+* sv.r.source() is buggy + add in menus/toolbars
+
+* Package help, vignettes, demos, packages management
+
+* doBraceMatch
+
+* setwd() with GUI
+
+* Finalize the R starting functions and place them in extensions; eliminate
+"R kernels"
+
+* R reference cards
+
+* R completion
+
+* All the Tinn-R function that are still missing
+
+* Make a Tinn-R GUI with simili-Tinn-R menus
+
+* Make ESS functions + the ESS GUI
+
+* Make R and Rd syntax highlighting; sweave later on
+
+* Allow for projects in packages (developments and binaries)
+
+* Make the User's and Developer's manuals
+
+* Update the web site
Modified: pkg/svGUI/DESCRIPTION
===================================================================
--- pkg/svGUI/DESCRIPTION 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svGUI/DESCRIPTION 2008-06-23 01:33:08 UTC (rev 12)
@@ -2,8 +2,8 @@
Title: SciViews GUI API - Functions to manage GUI client
Depends: R (>= 2.7.0), svMisc, svSocket
Description: Functions to manage the GUI client, like Komodo with the SciViews-K extension
-Version: 0.9-40
-Date: 2008-06-01
+Version: 0.9-42
+Date: 2008-06-23
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL (>= 2)
Modified: pkg/svGUI/NEWS
===================================================================
--- pkg/svGUI/NEWS 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svGUI/NEWS 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,5 +1,14 @@
= svGUI News
+== Changes in svGUI 0.9-42
+* koCmd() is now more robust and do not issue a warning or an error if the
+Komodo server is not available (but the error message is returned by the
+function with a 'try-error' class, so that it can be processed by the caller)
+
+== Changes in svGUI 0.9-41
+* Correction of a bug in the first example of koCmd()
+* guiInstall() now creates a hook to koCmd(): .koCmd() in TempEnv environment
+
== Changes in svGUI 0.9-40
This is the first version distributed on R-forge. It is completely refactored
from older versions (on CRAN since 2003) to make it run with SciViews-K and
Modified: pkg/svGUI/R/guiInstall.R
===================================================================
--- pkg/svGUI/R/guiInstall.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svGUI/R/guiInstall.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,7 +1,7 @@
"guiInstall" <-
function() {
assignTemp(".guiCmd", function(command, ...) {
- switch(command, ### TODO: create these commands!
+ command <- switch(command, ## TODO: define these commands
load = "",
source = "",
save = "",
@@ -9,8 +9,7 @@
export = "",
report = "",
setwd = "",
- ""
- )
+ "")
})
assignTemp(".guiObjBrowse", function(id, data) {
koCmd('sv.objBrowse("<<<id>>>", "<<<dat>>>");', list(id = id, dat = data))
@@ -22,6 +21,17 @@
koCmd('sv.objMenu("<<<id>>>", "<<<dat>>>");', list(id = id, dat = data))
})
+ # Functions specific to Komodo as a GUI client
+ assignTemp(".koCmd", function(command, ...) {
+ # This mechanism avoids dependence on svGUI for packages that provide
+ # functionalities that work with or without Komodo (like svUnit)
+ # Instead of calling koCmd() directly, we look if .koCmd is defined
+ # in tempenv and we run it.
+ # This allows also redefining koCmd() without changing code in the
+ # packages that depend on .koCmd()
+ koCmd(command, ...)
+ })
+
# Register a TaskCallback to generate automatically informations for an object browser
# Use getTaskCallbackNames() to know if some tasks are registered
assignTemp(".guiObjCallback", function(...) {
Modified: pkg/svGUI/R/guiUninstall.R
===================================================================
--- pkg/svGUI/R/guiUninstall.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svGUI/R/guiUninstall.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -5,6 +5,8 @@
rmTemp(".guiObjBrowse")
rmTemp(".guiObjInfo")
rmTemp(".guiObjMenu")
+
+ rmTemp(".koCmd")
# Unregister the TaskCallback
# Use getTaskCallbackNames() to know if some tasks are registered
Modified: pkg/svGUI/R/koCmd.R
===================================================================
--- pkg/svGUI/R/koCmd.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svGUI/R/koCmd.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -10,14 +10,14 @@
return("")
}
# Do we need to paste data in the command?
- if (!is.null(data)) {
+ if (!is.null(data)) {
"rework" <- function(data) {
data <- as.character(data)
data <- gsub("\n", "\\\\\\\\n", data)
data <- paste(data, collapse = "\\\\n")
return(data)
}
-
+
n <- names(data)
if (is.null(n)) {
# We assume that we replace '<<<data>>>'
@@ -29,7 +29,16 @@
rework(data[[n[i]]]), cmd)
}
}
- con <- socketConnection(host = host, port = port, blocking = TRUE)
+ owarn <- getOption("warn")
+ options(warn = -1) # Eliminate warnings (in case the Komodo server is not available)
+ ret <- try(con <- socketConnection(host = host, port = port, blocking = TRUE),
+ silent = TRUE)
+ options(warn = owarn) # Restore warnings
+ if (inherits(ret, "try-error")) {
+ data <- "Komodo socket server is not available!"
+ class(data) <- "try-error"
+ return(data)
+ }
writeLines(cmd, con)
res <- readLines(con)
close(con)
Modified: pkg/svGUI/TODO
===================================================================
--- pkg/svGUI/TODO 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svGUI/TODO 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,5 +1,7 @@
= svGUI To Do list
+* The svGUI-package.Rd man page
+
* Write the whole API to access Komodo from R
* Translate this package
\ No newline at end of file
Modified: pkg/svGUI/man/guiInstall.Rd
===================================================================
--- pkg/svGUI/man/guiInstall.Rd 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svGUI/man/guiInstall.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -5,7 +5,7 @@
\title{ Install and uninstall hooks for communicating with the GUI client (Komodo) }
\description{
Install functions in TempEnv and callbacks required to communicate with Komodo
- Edit with the Sciviews-K extension.
+ Edit with the SciViews-K extension (see http://www.sciviews.org/SciViews-K).
}
\usage{
guiInstall()
@@ -18,18 +18,22 @@
\details{
The minimum instruction to set up everything in R to communication with Komodo
- and SciViews-K extension installed (see http://www.sciviews.org/SciViews-K)
- is to use: \code{option(ko.serve = 8888); require(svGUI)}. When the
- \code{ko.serve} option is set, svGUI load svSocket, starts the socket server
- litening to the port you give in \code{ko.serve} (8888 by default), and install
- the hooks and callbacks required to fully communicate with Komodo.
-
- Before loading svGUI, you can also set \code{option(ko.port = 7052)} or another
- port number where the Komodo SciViews-K server is listening (7052 is the
- default value). If the Komodo client is running on a different machine, you
- should also set \code{ko.host = "xxx.xxx.xxx.xxx"}, where xxx.xxx.xxx.xxx is
- the IP address of the Komodo client's machine, before loading svGUI.
-
+ and SciViews-K extension installed is to use:
+ \code{option(ko.serve = 8888); require(svGUI)}. When the \code{ko.serve}
+ option is set, svGUI load svSocket, starts the socket server litening to the
+ port you give in \code{ko.serve} (8888 by default), and install the hooks and
+ callbacks required to fully communicate with Komodo.
+
+ Before loading svGUI, you can also set \code{option(ko.port = 7052)} or
+ another port number where the Komodo SciViews-K server is listening (7052 is
+ the default value). If the Komodo client is running on a different machine,
+ you should also set \code{ko.host = "xxx.xxx.xxx.xxx"}, where xxx.xxx.xxx.xxx
+ is the IP address of the Komodo client's machine, before loading svGUI (note
+ that running R and Komodo on separate machines is not supported yet, but this
+ is a planned feature and corresponding configurations are already recognized;
+ just, distant server is currently locked until we will build a better security
+ mechanism in the server (SSL, TSL, ...).
+
All these operations are done by Komodo if you start R from Komodo with
SciViews-K extension installed.
}
Modified: pkg/svGUI/man/koCmd.Rd
===================================================================
--- pkg/svGUI/man/koCmd.Rd 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svGUI/man/koCmd.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -33,7 +33,7 @@
\value{
Returns the results of the evaluation of the javascript code in Komodo Edit if
\code{async = FALSE}. Note that \code{async = TRUE} is not supported yet.
-
+
If there is an error, or \code{cmd} is an invalid javascript code, an error
is returned with the class \'try-error\' (see last example).
}
@@ -48,7 +48,7 @@
(see http://www.sciviews.org/SciViews-R) in a platform independent solution
using Komodo with a specific extension named SciViews-K and the SciViews-R
bundle.
-
+
\code{koCmd()} can only talk to Komdo if the SciViews-K socket server is
installed. This server is contained in the SciViews-K extension that you can
download from http://www.sciviews.org/SciViews-K. See Komodo documentation to
@@ -63,7 +63,7 @@
Because of serious security issues, the SciViews-K server only allows
connections from local clients (running on the same computer). This limitation
would be relatively easy to eliminate, but at your own risks!
-
+
Data are returned to R by using the javascript function
\code{sv.socket.serverWrite()}, see the examples bellow.
}
@@ -79,8 +79,8 @@
# on the same machine you run R, and the socket server started and then...
# Alert box in Komodo, and then reply to R
-koCmd(c('alert("Hello from R!")',
- 'sv.socket.serverWrite("Hello from OpenKomodo (" + ko.interpolate.currentFilePath() + ")")'))
+koCmd(c('alert("Hello from R!");',
+ 'sv.socket.serverWrite("Hello from OpenKomodo (" + ko.interpolate.currentFilePath() + ")");'))
# Open a web page wih Komodo configuration
koCmd("ko.open.URI('about:config','browser');")
Modified: pkg/svIDE/DESCRIPTION
===================================================================
--- pkg/svIDE/DESCRIPTION 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svIDE/DESCRIPTION 2008-06-23 01:33:08 UTC (rev 12)
@@ -4,7 +4,7 @@
Depends: R (>= 2.7.0), tcltk, svMisc
Description: Function for the GUI API to interact with external IDE/code editors
Version: 0.9-43
-Date: 2008-06-12
+Date: 2008-06-23
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL (>= 2)
Modified: pkg/svIDE/R/TinnR.R
===================================================================
--- pkg/svIDE/R/TinnR.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svIDE/R/TinnR.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -41,10 +41,9 @@
"list", "function", "NULL", "language",
"S3", "S4")
NewGroup <- GrpTable[res$Group]
- NewGroup[NewGroup == "vector" & (regexpr("x", res$Dims) > -1)] <- "array"
- NewGroup[NewGroup == "array" &
- (regexpr("^[0-9]+x[0-9]+$", res$Dims) > -1)] <- "matrix"
- NewGroup[res$Class == "table"] <- "table"
+ NewGroup[res$Class == "matrix"] <- "matrix"
+ NewGroup[res$Class == "array"] <- "array"
+ NewGroup[res$Class == "table"] <- "table"
res$Group <- NewGroup
# Filter according to group
Modified: pkg/svIDE/TODO
===================================================================
--- pkg/svIDE/TODO 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svIDE/TODO 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,3 +1,5 @@
= svIDE To Do list
+* The svIDE-package.Rd man page
+
* Translate this package
Modified: pkg/svMisc/TODO
===================================================================
--- pkg/svMisc/TODO 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svMisc/TODO 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,5 +1,7 @@
= svMisc To Do list
+* The svMisc-package.Rd man page
+
* Write the code in objList() to list content inside objects
* Rework mechanism to call .guiCmd() from objXXX() functions
@@ -7,8 +9,8 @@
* Make indeterminate progress()ion
* Use this in call tips to get the call for S3 method for given objects
- args(getS3method("predict", class(myobj), optional = TRUE)). + selectMethod
- for S4 object does the same thing!
+args(getS3method("predict", class(myobj), optional = TRUE)). + selectMethod
+for S4 object does the same thing!
* objMenu(): add copy name to clipboard, send name to editor in menu
Modified: pkg/svSocket/TODO
===================================================================
--- pkg/svSocket/TODO 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svSocket/TODO 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,15 +1,17 @@
= svSocket To Do list
+* svSocket-package.Rd man page
+
* Easy redefinition of options(width = ...) to adjust width of output to the
- GUI client R console
+GUI client R console
* Make use of a config file for the server + parSocketServer() to change (some!)
- parameters of the server
+parameters of the server
* Translation of all messages in the package
* Delete SocketClient_xxxx on disconnection + make sure they are all deleted
- on server stopping and on package detaching (in .Last.lib())
+on server stopping and on package detaching (in .Last.lib())
* Parse error => rework message a little bit + line number is 1 too much
@@ -24,12 +26,12 @@
* A mode that flags various parts of output
* Parse and executes one command at a time in case several commands are send at
- once (should we? The current way of working has some interesting features!)
+once (should we? The current way of working has some interesting features!)
* Unattended messages should be printed above command line
* Allow for remote connection + security?
- Use a tcl list:
+Use a tcl list:
% set xxxx_allow [list]
% llength $xxxx_allow
% lappend xxxx_allow "194.127.34.1"
@@ -64,7 +66,7 @@
* <<<E>>> with addition of the command in the R command history
* Check and solve possible clash when several clients submit commands at the
- same time
+same time
== Differences between CLI and processSocket()
@@ -73,63 +75,63 @@
* When successive commands are issued and the last one is incomplete like:
> search(); log(
- processSocket() waits for a complete last command before processing everything
- while other consoles process all the commands and then wait for last one to be
- completed (should be considered as a feature)
+processSocket() waits for a complete last command before processing everything
+while other consoles process all the commands and then wait for last one to be
+completed (should be considered as a feature)
* Same problem with multiple instructions send at once when there is an error:
- the first few correct instructions before the error should be evaluated, while
- they are not with processSocket() (considered as a feature). Compare this
+the first few correct instructions before the error should be evaluated, while
+they are not with processSocket() (considered as a feature). Compare this
> search(); log)
* For long calculations, processSocket() acts as a buffered console (like RGui)
- except that it does not understand (yet) flush.console!
+except that it does not understand (yet) flush.console!
* There are sometimes cosmetic differences in the way warnings are printed
- (essentially, truncation of call argument). For instance:
+(essentially, truncation of call argument). For instance:
> options(warn = 0)
> (function() {warning("Warn!"); 1:3})()
* There are slight differences in the way the error message is presented when
- incorrect code is processed. Moreover, R.app (Macintosh) does not print a
- descriptive error message, but only "syntax error". This is an old behaviour
- that remains only in R.app (among all tested consoles)
+incorrect code is processed. Moreover, R.app (Macintosh) does not print a
+descriptive error message, but only "syntax error". This is an old behaviour
+that remains only in R.app (among all tested consoles)
* R.app (Macintosh) always print prompts at the beginning of a line. So,
- cat("text") does not produce exactly the same result as in many other consoles
- including with processSocket() (should be considered wrong in R.app!)
+cat("text") does not produce exactly the same result as in many other consoles
+including with processSocket() (should be considered wrong in R.app!)
* R.app (Macintosh) incorrectly prints a continuation prompt after:
> options(warn = 2)
> (function() {warning("Warn!"); 1:3})()
* R.app (Macintosh) does not interpret \a and \b on the contrary to most other
- consoles. With processSocket(), it is the client that must decide how to
- interpret special characters. Most important ones are: \a => sound a bip and
- print nothing, \b = backspace, erase previous character, except if at the
- beginning of a line, \t = tabulation (4 spaces), \n = newline, \r = same as \n
- (but not interpreted on RGui), \r\n = same as \n, \r\r and \n\r are
- equivalent to \n\n (for portability) from one platform to the other. \f and \v
- are interpreted as \n (but not on RGui under Windows), \u and \x are also
- recognized but interpreted differently from one to the other console, as well
- as the other exotic escape sequences. It is better to ignore them, or to print
- a question mark instead.
+consoles. With processSocket(), it is the client that must decide how to
+interpret special characters. Most important ones are: \a => sound a bip and
+print nothing, \b = backspace, erase previous character, except if at the
+beginning of a line, \t = tabulation (4 spaces), \n = newline, \r = same as \n
+(but not interpreted on RGui), \r\n = same as \n, \r\r and \n\r are
+equivalent to \n\n (for portability) from one platform to the other. \f and \v
+are interpreted as \n (but not on RGui under Windows), \u and \x are also
+recognized but interpreted differently from one to the other console, as well
+as the other exotic escape sequences. It is better to ignore them, or to print
+a question mark instead.
* Regarding internationalization of error messages, there are two differences
- between messages at the CLI and issued by processSocket():
+between messages at the CLI and issued by processSocket():
- Warning message(s): is not translated at CLI bu it is translated by
- processSocket() (bug?) in:
+processSocket() (bug?) in:
> options(warn = 0)
> warning("Warn!")
- On the contrary, processSocket() fails to translate 'Error in' for most
- error messages, and I don't understand this bug:
+error messages, and I don't understand this bug:
> cos("a")
* If you define options(warning.expression), there will be a problem because
- processSocket() redefines it also, and thus, at best, you expression is
- ignored (must fix this!)
+processSocket() redefines it also, and thus, at best, you expression is
+ignored (must fix this!)
* On the MacOS X, there are many mismatches for string translation, bot at the
- command line and using processSocket(), but they are not same mismatches!
\ No newline at end of file
+command line and using processSocket(), but they are not same mismatches!
Modified: pkg/svUnit/DESCRIPTION
===================================================================
--- pkg/svUnit/DESCRIPTION 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/DESCRIPTION 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,10 +1,10 @@
Package: svUnit
Title: SciViews GUI API - Unit testing
-Depends: R (>= 1.9.0), RUnit
-Suggests: svGUI
-Description: Functions to implement the GUI part of a unit test system based on RUnit
-Version: 0.4-0
-Date: 2008-06-11
+Depends: R (>= 1.9.0)
+Suggests: svGUI, datasets, utils
+Description: A complete unit test system and functions to implement its GUI part
+Version: 0.6-0
+Date: 2008-06-23
Author: Philippe Grosjean
Maintainer: Philippe Grosjean <phgrosjean at sciviews.org>
License: GPL 2 or above
Modified: pkg/svUnit/NAMESPACE
===================================================================
--- pkg/svUnit/NAMESPACE 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/NAMESPACE 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,30 +1,63 @@
-import(RUnit)
+export( as.svSuite,
+ as.svTest,
+ checkEquals,
+ checkEqualsNumeric,
+ checkIdentical,
+ checkTrue,
+ checkException,
+ clearLog,
+ createLog,
+ DEACTIVATED,
+ errorLog,
+ guiSuiteAutoList,
+ guiSuiteList,
+ guiTestFeedback,
+ guiTestReport,
+ koUnit_isAutoTest,
+ koUnit_setAutoTest,
+ koUnit_runTest,
+ koUnit_showRUnitPane,
+ koUnit_version,
+ is.svSuite,
+ is.svSuiteData,
+ is.svTest,
+ is.svTestData,
+ is.test,
+ lastSuite,
+ lastTest,
+ Log,
+ makeUnit,
+ metadata,
+ protocol,
+ protocol_text,
+ runTest,
+ stats,
+ svSuite,
+ svSuiteList,
+ svTest,
+ test,
+ "test<-")
-export(svTest,
- as.svTest,
- is.svTest,
- is.test,
- test,
- "test<-",
- makeUnit,
- runTest,
- svUnit,
- as.svUnit,
- is.svUnit,
- svUnitList,
- runUnit,
- unitClear,
- unitError)
-
S3method(makeUnit, default)
S3method(makeUnit, svTest)
-S3method(makeUnit, svUnit)
+S3method(makeUnit, svSuite)
+S3method(metadata, svSuiteData)
+
+S3method(print, svSuite)
+S3method(print, svSuiteData)
+S3method(print, svTest)
+S3method(print, svTestData)
+
+S3method(protocol, default)
+S3method(protocol_text, svSuiteData)
+
S3method(runTest, default)
S3method(runTest, svTest)
-S3method(runTest, svUnit)
+S3method(runTest, svSuite)
-S3method(print, svUnit)
+S3method(stats, svSuiteData)
+S3method(stats, svTestData)
-S3method(print, svUnitData)
-S3method(summary, svUnitData)
+S3method(summary, svSuiteData)
+S3method(summary, svTestData)
Modified: pkg/svUnit/NEWS
===================================================================
--- pkg/svUnit/NEWS 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/NEWS 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,4 +1,36 @@
= svUnit News
-== svUnit 0.1-0
+== svUnit 0.6-0
+* The package does not depends any more from RUnit. It has his own checkXXX()
+function (they are compatible with those in RUnit 0.4.17, except that here the
+checkTrue() function is vectorized, but they operate very differently),
+
+* svUnit functions and objects are renamed svSuite, and there is a reworking of
+objects to end with svTest, svSuite, svTestData and svSuiteData, and many new
+methods for those objects (print, summary, stats, metadata, makeUnit, runTest)
+
+* print.svSuiteData and summary.svSuiteData are completely reworked.
+
+* svSuiteList() now accepts additional, dirs, manages an exclusion list and has
+an argument 'loadPackages' to force loading packages provided in the list.
+
+* Names for test units is now runit<name>.R, like in the RUnit package. Same for
+the test functions which are test<name>.R (used to be runit.<name>.R and
+test.<name.R).
+
+* The temporary directory is now emptied from old runit*.R files before making
+new ones, but not any more after running tests. That way, we avoid running old
+test definitions, while keeping the latest one available for inspection.
+
+* koUnit_xxx() functions have been added to manipulate the R Unit GUI in
+Komodo from within R.
+
+
+== svUnit 0.5-0
+* Added guiTestFeedback() and guiTestReport() functions.
+
+* A couple of other little changes.
+
+
+== svUnit 0.4-0
First version compiled as a package and distributed on R-Forge.
Added: pkg/svUnit/R/Log.R
===================================================================
--- pkg/svUnit/R/Log.R (rev 0)
+++ pkg/svUnit/R/Log.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,71 @@
+Log <-
+function (description = NULL) {
+ if (!exists(".Log", envir = .GlobalEnv, inherits = FALSE))
+ createLog(description = description)
+ return(get(".Log", envir = .GlobalEnv, inherits = FALSE))
+}
+
+createLog <-
+function (description = NULL, deleteExisting = FALSE) {
+ # Create a log consisting in an environment with class svSuiteData
+ if (isTRUE(deleteExisting) && exists(".Log", envir = .GlobalEnv,
+ inherits = FALSE)) rm(.Log, envir = .GlobalEnv)
+ if (!exists(".Log", envir = .GlobalEnv, inherits = FALSE)) {
+ .Log <<- structure(new.env(parent = .GlobalEnv),
+ class = c("svSuiteData", "environment"))
+ # Add general informations and variables to it
+ .Log$.time <- Sys.time() # Creation time of the log
+ .Log$.R.version <- R.version # R version
+ .Log$.sessionInfo <- sessionInfo() # Information about current session
+ .Log$.description <- description # Optional description of this log
+ # Create ..xxx variables used for test context
+ # Note: never delete or put NULL in these variables, use "" instead
+ .Log$..Unit <- ""
+ .Log$..Msg <- ""
+ .Log$..Obj <- ""
+ .Log$..File <- ""
+ .Log$..Tag <- ""
+ # Create .lastTest that contains details from last check...()
+ naChr <- as.character(NA)
+ .Log$.lastTest <- structure(
+ data.frame(msg = naChr, call = naChr,
+ timing = as.numeric(NA), kind = .kind(NA), res = naChr,
+ obj = naChr, file = naChr, tag = naChr,
+ stringsAsFactors = FALSE),
+ class = c("svTestData", "data.frame"))
+ # Create .lastSuite with an empty list of test units to run
+ .Log$.lastSuite <- list()
+ }
+}
+
+clearLog <-
+function () {
+ if (exists(".Log", envir = .GlobalEnv, inherits = FALSE)) {
+ rm(list = ".Log", envir = .GlobalEnv)
+ return(invisible(TRUE))
+ } else return(invisible(FALSE))
+}
+
+errorLog <-
+function (stopit = TRUE, summarize = TRUE) {
+ .Log <- Log()
+ Res <- table(stats(.Log)$kind)
+ if (isTRUE(stopit) && any(Res[2:3] > 0)) {
+ if (isTRUE(summarize)) summary(.Log)
+ msg <- paste(Res[2], "failure(s) and", Res[3], "error(s)")
+ stop(msg)
+ }
+ return(invisible(Res))
+}
+
+lastTest <-
+function () {
+ # Return a svTestData object with data from last recorded test
+ Log()$.lastTest
+}
+
+lastSuite <-
+function () {
+ # Return data about last suite run
+ Log()$.lastSuite
+}
Added: pkg/svUnit/R/check.R
===================================================================
--- pkg/svUnit/R/check.R (rev 0)
+++ pkg/svUnit/R/check.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,183 @@
+# Define check...() functions in a way they are compatible with same functions
+# in the 'RUnit' package (these functions are directly inspired from those
+# in RUnit). Make version that are more compatible with Komodo/SciViews-K Unit)
+
+checkEquals <-
+function (target, current, msg = "", tolerance = .Machine$double.eps^0.5,
+checkNames = TRUE, ...) {
+ val <- FALSE
+ timing <- as.numeric(system.time({
+ ret <- try({
+ # Run the test
+ if (isTRUE(checkNames)) {
+ cn <- "" # Since this is the default value
+ } else {
+ cn <- ", checkNames = FALSE"
+ names(target) <- NULL
+ names(current) <- NULL
+ }
+ if (!is.numeric(tolerance))
+ stop("tolerance has to be a numeric value")
+ if (length(tolerance) != 1)
+ stop("tolerance has to be a scalar")
+ res <- all.equal(target, current, tolerance = tolerance, ...)
+ val <- isTRUE(res)
+ }, silent = TRUE)
+ }, gcFirst = FALSE)[3])
+ # Log this test
+ test <- .logTest(timing)
+ # Decide if recording more info or not
+ minTiming <- getOption("svUnit.minTiming")
+ if (is.null(minTiming)) minTiming <- 0.1
+ if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
+ && val) return(invisible(TRUE))
+ # Check for error
+ if (inherits(ret, "try-error")) {
+ val <- NA
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:3], nlines = 1), timing = timing, val = -1,
+ res = as.character(ret))
+ } else {
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:3], nlines = 1), timing = timing, val = val,
+ res = if (val) "" else paste(c(res, .formatResult(current)),
+ collapse = "\n"))
+ }
+ return(invisible(val))
+}
+
+checkEqualsNumeric <-
+function (target, current, msg = "", tolerance = .Machine$double.eps^0.5, ...) {
+ val <- FALSE
+ timing <- as.numeric(system.time({
+ ret <- try({
+ # Run the test
+ if (!is.numeric(tolerance))
+ stop("tolerance has to be a numeric value")
+ if (length(tolerance) != 1)
+ stop("tolerance has to be a scalar")
+ res <- all.equal.numeric(as.vector(target), as.vector(current),
+ tolerance = tolerance, ...)
+ val <- isTRUE(res)
+ }, silent = TRUE)
+ }, gcFirst = FALSE)[3])
+ # Log this test
+ test <- .logTest(timing)
+ # Decide if recording more info or not
+ minTiming <- getOption("svUnit.minTiming")
+ if (is.null(minTiming)) minTiming <- 0.1
+ if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
+ && val) return(invisible(TRUE))
+ # Check for error
+ if (inherits(ret, "try-error")) {
+ val <- NA
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:3], nlines = 1), timing = timing, val = -1,
+ res = as.character(ret))
+ } else {
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:3], nlines = 1), timing = timing, val = val,
+ res = if (val) "" else paste(c(res, .formatResult(current)),
+ collapse = "\n"))
+ }
+ return(invisible(val))
+}
+
+checkIdentical <-
+function (target, current, msg = "") {
+ val <- FALSE
+ timing <- as.numeric(system.time({
+ ret <- try({
+ # Run the test
+ val <- identical(target, current)
+ }, silent = TRUE)
+ }, gcFirst = FALSE)[3])
+ # Log this test
+ test <- .logTest(timing)
+ # Decide if recording more info or not
+ minTiming <- getOption("svUnit.minTiming")
+ if (is.null(minTiming)) minTiming <- 0.1
+ if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
+ && val) return(invisible(TRUE))
+ # Check for error
+ if (inherits(ret, "try-error")) {
+ val <- NA
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:3], nlines = 1), timing = timing, val = -1,
+ res = as.character(ret))
+ } else {
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:3], nlines = 1), timing = timing, val = val,
+ res = .formatResult(current))
+ }
+ return(invisible(val))
+}
+
+checkTrue <-
+function (expr, msg = "") {
+ val <- FALSE
+ timing <- as.numeric(system.time({
+ ret <- try({
+ # Run the test
+ val <- isTRUE(all(expr == TRUE))
+ }, silent = TRUE)
+ }, gcFirst = FALSE)[3])
+ # Log this test
+ test <- .logTest(timing)
+ # Decide if recording more info or not
+ minTiming <- getOption("svUnit.minTiming")
+ if (is.null(minTiming)) minTiming <- 0.1
+ if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
+ && val) return(invisible(TRUE))
+ # Get call, without msg
+ call <- sys.call()
+ call <- deparse(call[names(call) != "msg"])
+ # Check for error
+ if (inherits(ret, "try-error")) {
+ val <- NA
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:2], nlines = 1), timing = timing, val = -1,
+ res = as.character(ret))
+ } else {
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:2], nlines = 1), timing = timing, val = val,
+ res = .formatResult(expr))
+ }
+ return(invisible(val))
+}
+
+checkException <-
+function (expr, msg = "", silent = getOption("svUnit.silentException")) {
+ val <- FALSE
+ timing <- as.numeric(system.time({
+ ret <- try({
+ # Run the test
+ silent <- (is.null(silent) || isTRUE(silent))
+ val <- inherits(res <- try(expr, silent = silent), "try-error")
+ }, silent = TRUE)
+ }, gcFirst = FALSE)[3])
+ # Log this test
+ test <- .logTest(timing)
+ # Decide if recording more info or not
+ minTiming <- getOption("svUnit.minTiming")
+ if (is.null(minTiming)) minTiming <- 0.1
+ if (!isTRUE(getOption("svUnit.recordAll")) && isTRUE(timing < minTiming)
+ && val) return(invisible(TRUE))
+ # Check for error
+ if (inherits(ret, "try-error")) {
+ val <- NA
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:2], nlines = 1), timing = timing, val = -1,
+ res = as.character(ret))
+ } else {
+ .logTestData(test, msg = msg, call =
+ deparse(sys.call()[1:2], nlines = 1), timing = timing, val = val,
+ res = if (val) paste(res, collapse = "\n") else
+ "No exception generated!\n")
+ }
+ return(invisible(val))
+}
+
+DEACTIVATED <-
+function (msg = "")
+ stop(msg)
Added: pkg/svUnit/R/guiTestReport.R
===================================================================
--- pkg/svUnit/R/guiTestReport.R (rev 0)
+++ pkg/svUnit/R/guiTestReport.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,136 @@
+guiSuiteList <-
+function (sep = "\t", path = NULL, compare = TRUE) {
+ Suites <- svSuiteList()
+ if (compare) {
+ oldSuites <- .getTemp(".guiSuiteListCache", default = "")
+ # Compare both versions
+ if (!identical(Suites, oldSuites)) {
+ # Keep a copy of the last version in TempEnv
+ .assignTemp(".guiSuiteListCache", Suites)
+ Changed <- TRUE
+ } else Changed <- FALSE
+ } else {
+ Changed <- TRUE
+ .assignTemp(".guiSuiteListCache", Suites)
+ }
+ if (is.null(path)) { # Return result, as a single character string with sep
+ if (Changed) {
+ if (!is.null(sep)) Suites <- paste(Suites, collapse = sep)
+ return(Suites)
+ } else return(NULL)
+ } else { # Write to a file called 'Suites.txt' in this path
+ file <- file.path(path, "Suites.txt")
+ if (Changed) {
+ if (is.null(sep)) sep <- "\n"
+ cat(Suites, sep = sep, file = file)
+ }
+ return(invisible(Changed))
+ }
+}
+
+guiSuiteAutoList <-
+function (...) {
+ # Is koCmd() available?
+ if (!exists("koCmd", mode = "function")) return(TRUE)
+ # Is it something changed in the unit list?
+ res <- guiSuiteList(sep = ",", path = NULL, compare = TRUE)
+ if (!is.null(res))
+ ret <- get("koCmd")('sv.r.unit.getRUnitList_Callback("<<<data>>>");',
+ data = res)
+ return(TRUE)
+}
+
+guiTestFeedback <-
+function (object, path = NULL, ...) {
+ # Give feedback to client about the currently running tests
+ ### TODO: feedback about test run
+}
+
+guiTestReport <-
+function (object, sep = "\t", path = NULL, ...) {
+ # Report the results of a test to the GUI client
+ if (!is.svSuiteData(object))
+ stop("'object' must be a 'svSuiteData' object")
+
+ # For all 'svTestData' objects, create a table with test results for the GUI
+ # Indicate global results of the Unit Test
+ Tests <- ls(object)
+ if (length(Tests) == 0) {
+ Res <- "<<<svUnitSummary>>>|||0|||0|||0|||0"
+ } else {
+ # Get general information about the tests
+ Stats <- stats(object)
+ Tests <- rownames(Stats) # To make sure we use the same!
+ Stats$label <- paste(">", sub("^test", "", Tests), " (",
+ round(Stats$timing, 3), " sec)", sep = "")
+ State <- table(Stats$kind)
+ Res <- paste("<<<svUnitSummary>>>|||", State[1], "|||", State[2],
+ "|||", State[3], "|||", State[4], sep = "")
+ Kinds <- as.numeric(Stats$kind)
+ Kinds[Kinds == 4] <- 0 # Use 0 instead of 4 for deactivated tests
+ Stats$kind <- Kinds
+ # Get the type for the objects
+ Units <- Stats$unit
+ Types <- rep("units in packages", length(Units))
+ Types[Units == ""] <- "other objects"
+ ### TODO: include also dirs!
+ Dir1 <- dirname(Units)
+ Dir2 <- dirname(Dir1)
+ Dir3 <- dirname(Dir2)
+ Types[Dir1 == tempdir()] <- "objects in .GlobalEnv"
+ Types[tolower(basename(Dir2)) == "inst" ||
+ tolower(basename(Dir3)) == "inst"] <- "units in sources"
+ # Keep only "*" in Units
+ Units <- basename(Units)
+ Units[regexpr("^runit.+\\.[rR]$", Units) == -1] <- ""
+ Units[Dir1 == tempdir()] <- "" # No second level for objects in .GlobalEnv
+ Units <- sub("^runit(.+)\\.[rR]$", "\\1", Units)
+ change <- Units != ""
+ Units[change] <- paste(">unit", Units[change])
+ # Complete label is Type<Unit<Test (x.xxx sec)
+ Stats$label <- paste(Types, Units, Stats$label, sep = "")
+ # Sort Tests and Stats according to label alphabetically
+ ord <- order(Stats$label)
+ Stats <- Stats[ord, ]
+ Tests <- Tests[ord]
+ # Get detailed information about each test
+ lastUnit <- ""
+ for (Test in Tests) {
+ Data <- Stats[Test, ]
+ # Calculate Info
+ tData <- Log()[[Test]]
+ tStats <- stats(tData)
+ Info <- paste(c("Pass:", "Fail:", "Errors:"), tStats$kind[1:3],
+ collapse = " ")
+ # Don't print tests that succeed if !all
+ tData <- tData[tData$kind != "OK", ]
+ # Get info about each individual filtered test
+ if (nrow(tData) > 0) {
+ Result <- ifelse(tData$res == "", "",
+ paste("\n", tData$res, sep = ""))
+ Info <- paste(Info, "\n", paste("* ", tData$msg, ": ", tData$call,
+ .formatTime(tData$timing, secDigits = 3), " ... ",
+ as.character(tData$kind), Result, sep = "", collapse = "\n"),
+ sep = "")
+ }
+ # Calculate URI (currently, the name of the unit file # and
+ # the name of the test function)
+ if (Data$unit == "") URI <- Data$unit else
+ URI <- paste(Data$unit, Test, sep = "#")
+ if (Data$unit != lastUnit) {
+ lastUnit <- Data$unit
+ Res <- c(Res, paste("<<<svUnitFile>>>|||", Data$unit,
+ "|||||||||", sep = ""))
+ }
+ Res <- c(Res, paste("<<<svUnitTest>>>|||", Data$label, "|||",
+ Data$kind, "|||", Info, "|||", URI, sep = ""))
+ }
+ }
+ Res <- paste(gsub("\t", " ", Res), collapse = sep)
+ if (is.null(path)) {
+ return(Res)
+ } else {
+ cat(Res, file = path)
+ }
+ return(path)
+}
Added: pkg/svUnit/R/koUnit.R
===================================================================
--- pkg/svUnit/R/koUnit.R (rev 0)
+++ pkg/svUnit/R/koUnit.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,43 @@
+.koUnit <-
+function(cmd, warn = FALSE, ...) {
+ # Look if koCmd() exists, otherwise, we are probably not connected to Komodo
+ if (exists("koCmd", mode = "function")) {
+ res <- get("koCmd")(cmd, ...)
+ if (isTRUE(warn) & inherits(res, "try-error"))
+ warning("Komodo is not available or did not process this command correctly")
+ return(res)
+ } else {
+ if (isTRUE(warn))
+ warning("You must establish a connection with Komodo/SciViews-K to use this function")
+ }
+}
+
+koUnit_isAutoTest <-
+function () {
+ res <- .koUnit('sv.socket.serverWrite(sv.r.unit.isAutoTest());')
+ return(res == "true")
+}
+
+koUnit_setAutoTest <-
+function (state) {
+ if (isTRUE(state)) state <- "true" else state <- "false"
+ res <- .koUnit('sv.r.unit.setAutoTest(<<<data>>>);', data = state)
+}
+
+koUnit_runTest <-
+function () {
+ res <- .koUnit('sv.r.unit.runTest();')
+}
+
+koUnit_showRUnitPane <-
+function (state) {
+ if (missing(state)) state <- ""
+ else if (isTRUE(state)) state <- "true" else state <- "false"
+ res <- .koUnit('sv.r.unit.showRUnitPane(<<<data>>>);', data = state)
+}
+
+koUnit_version <-
+function () {
+ res <- .koUnit('sv.socket.serverWrite(sv.r.unit.version + "." + sv.r.unit.release);')
+ return(res)
+}
Deleted: pkg/svUnit/R/runUnit.R
===================================================================
--- pkg/svUnit/R/runUnit.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/R/runUnit.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,245 +0,0 @@
-runUnit <-
-function(name, dirs, print.errors = !interactive(), warn = print.errors,
- rngKind = "Marsaglia-Multicarry", rngNormalKind = "Kinderman-Ramage") {
- # Define a test suite and run it more silently than done in RUnit
- # Also, increment counters with errors, failings and deactivated
-
- # Define a test suite and run it (same as defineTestSuite() in RUnit)
- testSuite <- list(name = name, dirs = dirs,
- testFileRegexp = "^runit.+\\.[rR]$", testFuncRegexp = "^test.+",
- rngKind = rngKind, rngNormalKind = rngNormalKind)
- class(testSuite) <- "RUnitTestSuite"
-
- # runTestSuite() prints results of tests, but we prefer to run it
- # more silently than in RUnit
- runSuite <- function (testSuite) {
- file <- textConnection("rval", "w", local = TRUE)
- sink(file, type = "output")
- sink(file, type = "message")
- on.exit({
- sink(type = "output")
- sink(type = "message")
- close(file)
- })
- return(runTestSuite(testSuites = testSuite))
- }
- res <- runSuite(testSuite)
-
- # Check that res is a 'RUnitTestData' object
- if (!inherits(res, "RUnitTestData"))
- stop("Result of runTestSuite() is not a 'RUnitTestData' object")
-
- # If there are errors, failures or deactivated items, increment counters
- err <- list(nErr = 0, nDeactivated = 0, nFail = 0, nTestFunc = 0)
- for (i in seq(length = length(res))) {
- err$nErr <- err$nErr + res[[i]]$nErr
- err$nDeactivated <- err$nDeactivated + res[[i]]$nDeactivated
- err$nFail <- err$nFail + res[[i]]$nFail
- }
-
- if (err$nErr > 0) {
- if (exists(".tests.errors", envir = .GlobalEnv, inherits = FALSE)) {
- nErr <- get(".tests.errors", envir = .GlobalEnv, inherits = FALSE)
- } else nErr <- 0
- assign(".tests.errors", nErr + err$nErr, envir = .GlobalEnv)
- }
- if (err$nFail > 0) {
- if (exists(".tests.failures", envir = .GlobalEnv, inherits = FALSE)) {
- nFail <- get(".tests.failures", envir = .GlobalEnv, inherits = FALSE)
- } else nFail <- 0
- assign(".tests.failures", nFail + err$nFail, envir = .GlobalEnv)
- }
- if (err$nDeactivated > 0) {
- if (exists(".tests.deactivated", envir = .GlobalEnv, inherits = FALSE)) {
- nDeactivated <- get(".tests.deactivated", envir = .GlobalEnv,
- inherits = FALSE)
- } else nDeactivated <- 0
- assign(".tests.deactivated", nDeactivated + err$nDeactivated, envir = .GlobalEnv)
- if (warn) warning("Test unit '", name, "' has ", err$nDeactivated, " deactivated items")
- }
-
- # Change class to c('svUnitData', 'RUnitTestData') to overload summary()
- class(res) <- c('svUnitData', 'RUnitTestData')
-
- # Do we print a summary of these tests in case of errors or failures?
- if (print.errors && (err$nErr + err$nFail) > 0)
- summary(res)
-
- return(invisible(res))
-}
-
-print.svUnitData <-
-function(x, ...) {
- if (!inherits(x, "svUnitData"))
- stop("'x' must be a 'svUnitData' object")
- if (length(x) == 0) {
- cat("no test cases\n")
- return(invisible(TRUE))
- }
- err <- list(nErr = 0, nDeactivated = 0, nFail = 0, nTestFunc = 0)
- for (i in seq(length = length(x))) {
- err$nErr <- err$nErr + x[[i]]$nErr
- err$nDeactivated <- err$nDeactivated + x[[i]]$nDeactivated
- err$nFail <- err$nFail + x[[i]]$nFail
- err$nTestFunc <- err$nTestFunc + x[[i]]$nTestFunc
- }
- cat("Number of test functions:", err$nTestFunc, "\n")
- if (err$nDeactivated > 0)
- cat("Number of deactivated test functions:", err$nDeactivated, "\n")
- cat("Number of errors:", err$nErr, "\n")
- cat("Number of failures:", err$nFail, "\n")
- return(invisible(x))
-}
-
-summary.svUnitData <-
-function(object, ...) {
- if (!inherits(object, "svUnitData"))
- stop("'object' must be a 'svUnitData' object")
-
- sop <- function(number, word, plext = "s") {
- ifelse(number == 1, paste(number, word), paste(number,
- paste(word, plext, sep = "")))
- }
-
- if (length(object) == 0) {
- cat("no test cases\n")
- return(invisible(object))
- }
- err <- list(nErr = 0, nDeactivated = 0, nFail = 0, nTestFunc = 0)
- for (i in seq(length = length(object))) {
- err$nErr <- err$nErr + object[[i]]$nErr
- err$nDeactivated <- err$nDeactivated + object[[i]]$nDeactivated
- err$nFail <- err$nFail + object[[i]]$nFail
- err$nTestFunc <- err$nTestFunc + object[[i]]$nTestFunc
- }
- cat("Number of test functions:", err$nTestFunc, "\n")
- if (err$nDeactivated > 0)
- cat("Number of deactivated test functions:", err$nDeactivated, "\n")
- cat("Number of errors:", err$nErr, "\n")
- cat("Number of failures:", err$nFail, "\n")
-
- if (err$nErr + err$nDeactivated + err$nFail == 0)
- return(invisible(object))
-
- cat("Details:\n")
- traceBackCutOff <- 9 # Cut unintersting part of the traceBack
- for (tsName in names(object)) {
- tsList <- object[[tsName]]
- cat("===========================\n")
- cat("Test Suite:", tsName, "\n")
- if (length(tsList$dirs) == 0) {
- cat("No directories !\n")
- } else {
- res <- tsList$sourceFileResults
- testFileNames <- names(res)
- if (length(res) == 0) {
- cat("no test files\n")
- } else {
- for (testFileName in testFileNames) {
- testFuncNames <- names(res[[testFileName]])
- if (length(testFuncNames) > 0) {
- cat("---------------------------\n")
- cat("Test file:", testFileName, "\n")
- for (testFuncName in testFuncNames) {
- testFuncInfo <- res[[testFileName]][[testFuncName]]
- if (testFuncInfo$kind == "success") {
- cat(testFuncName, ":", " ... OK (", testFuncInfo$time,
- " seconds)\n", sep = "")
- } else {
- if (testFuncInfo$kind == "error") {
- cat(testFuncName, ": ERROR !!\n", sep = "")
- } else if (testFuncInfo$kind == "failure") {
- cat(testFuncName, ": FAILURE !! (check number ",
- testFuncInfo$checkNum, ")\n", sep = "")
- } else if (testFuncInfo$kind == "deactivated") {
- cat(testFuncName, ": DEACTIVATED, ")
- } else {
- cat(testFuncName, ": unknown error kind\n", sep = "")
- }
- cat(testFuncInfo$msg)
- if (length(testFuncInfo$traceBack) > 0) {
- cat(" Call Stack:\n")
- if (traceBackCutOff > length(testFuncInfo$traceBack)) {
- cat(" (traceBackCutOff argument larger than length of trace back: full trace back printed)")
- for (i in 1:length(testFuncInfo$traceBack)) {
- cat(" ", i, ": ", testFuncInfo$traceBack[i],
- "\n", sep = "")
- }
- } else {
- for (i in traceBackCutOff:length(testFuncInfo$traceBack)) {
- cat(" ", 1 + i - traceBackCutOff,
- ": ", testFuncInfo$traceBack[i],
- "\n", sep = "")
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- return(invisible(TRUE))
-}
-
-unitClear <-
-function () {
- # Clear .tests.errors.tests.failures and .tests.deactivated from .GlobalEnv
- if (exists(".tests.errors", envir = .GlobalEnv, inherits = FALSE)) {
- nErr <- get(".tests.errors", envir = .GlobalEnv, inherits = FALSE)
- rm(".tests.errors", envir = .GlobalEnv, inherits = FALSE)
- } else nErr <- 0
- if (exists(".tests.failures", envir = .GlobalEnv, inherits = FALSE)) {
- nFail <- get(".tests.failures", envir = .GlobalEnv, inherits = FALSE)
- rm(".tests.failures", envir = .GlobalEnv, inherits = FALSE)
- } else nFail <- 0
- if (exists(".tests.deactivated", envir = .GlobalEnv, inherits = FALSE)) {
- nDeactivated <- get(".tests.deactivated", envir = .GlobalEnv,
- inherits = FALSE)
- rm(".tests.deactivated", envir = .GlobalEnv, inherits = FALSE)
- } else nDeactivated <- 0
- return(invisible(list(nErr = nErr, nDeactivated = nDeactivated,
- nFail = nFail)))
-}
-
-unitError <-
-function (errors = TRUE, failures = TRUE, deactivated = TRUE,
-stopit = TRUE) {
- # Read the content of .tests.errors and .tests.failures from .GlobalEnv
- allErr <- 0
- if (errors) {
- if (exists(".tests.errors", envir = .GlobalEnv, inherits = FALSE)) {
- nErr <- get(".tests.errors", envir = .GlobalEnv, inherits = FALSE)
- allErr <- nErr
- } else nErr <- 0
- } else nErr <- NA
-
- if (failures) {
- if (exists(".tests.failures", envir = .GlobalEnv, inherits = FALSE)) {
- nFail <- get(".tests.failures", envir = .GlobalEnv, inherits = FALSE)
- allErr <- allErr + nFail
- } else nFail <- 0
- } else nFail <- NA
-
- # Are there deactivated items?
- if (deactivated) {
- if (exists(".tests.deactivated", envir = .GlobalEnv, inherits = FALSE)) {
- nDeactivated <- get(".tests.deactivated", envir = .GlobalEnv,
- inherits = FALSE)
- if (stopit) # Issue a warning!
- warning("There are ", nDeactivated, " deactivated tests!")
- } else nDeactivated <- 0
- } else nDeactivated <- NA
-
- # Do we stop in case of any error?
- if (stopit && allErr > 0) {
- msg <- paste("\nUnit test errors: ", nErr, "\n")
- msg <- paste(msg, "Unit test failures: ", nFail, sep = "")
- stop(msg)
- }
- res <- (allErr == 0)
- attr(res, "errors") <- list(nErr = nErr, nDeactivated = nDeactivated,
- nFail = nFail)
- return(invisible(res))
-}
Added: pkg/svUnit/R/svSuite.R
===================================================================
--- pkg/svUnit/R/svSuite.R (rev 0)
+++ pkg/svUnit/R/svSuite.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,284 @@
+svSuite <-
+function (tests) {
+ # Check provided tests and build a 'svSuite' object
+ tests <- as.character(tests)
+ # Remove NAs and empty strings ("") from tests
+ tests <- tests[!is.na(tests) & !(tests == "")]
+ if (length(tests) > 0) {
+ # Tests must be character strings like:
+ # * package:PKG
+ # * package:PKG (TESTSUITE)
+ # * dir:MYDIR
+ # * test(OBJ) where OBJ is any object with a 'test' attribute
+ # * OBJ being a 'svTest' object (with non "exotic" name!),
+ # Syntax is checked, but not existence/validity of corresponding tests!
+ check1 <- (regexpr("^package:[a-zA-Z._]+$", tests) > -1)
+ check2 <- (regexpr("^package:[a-zA-Z._]+ *\\(.+\\)$", tests) > -1)
+ check3 <- (regexpr("^dir:.+", tests) > -1)
+ check4 <- (regexpr("^test\\(.+\\)$", tests) > -1)
+ check5 <- (regexpr("^[a-zA-Z0-9_.]+$", tests) > -1)
+ wrong <- ((check1 + check2 + check3 + check4 + check5) == 0)
+ if (any(wrong))
+ stop("Wrong 'tests' data: must be 'package:PKG', 'package:PKG (SUITE)',\n'dir:MYDIR', 'test(OBJ)' or 'OBJ'")
+ }
+ # This is a 'svSuite' object subclassing 'character'
+ class(tests) <- c("svSuite", "character")
+ return(tests)
+}
+
+as.svSuite <-
+function (x)
+ return(svSuite(x))
+
+is.svSuite <-
+function (x)
+ return(inherits(x, "svSuite"))
+
+print.svSuite <-
+function (x, ...) {
+ if (!is.svSuite(x))
+ stop("'x' must be a 'svSuite' object")
+ if (length(x) < 1) {
+ cat("An empty svUnit test suite\n")
+ } else {
+ cat("A svUnit test suite definition with:\n")
+ # Separate unit tests from tests embedded in objects
+ isSuite <- regexpr("^[package:|dir:]", x) > -1
+ if (any(isSuite)) {
+ Suites <- x[isSuite]
+ msg <- ifelse (length(Suites) == 1, "\n- Test suite:\n",
+ "\n- Test suites:\n")
+ cat(msg)
+ print(Suites)
+ }
+
+ if (any(!isSuite)) {
+ Objs <- x[!isSuite]
+ msg <- ifelse (length(Objs) == 1, "\n- Test function:\n",
+ "\n- Test functions:\n")
+ cat(msg)
+ print(Objs)
+ }
+ }
+ return(invisible(x))
+}
+
+svSuiteList <-
+function (packages = TRUE, objects = TRUE, dirs = getOption("svUnit.dirs"),
+ excludeList = getOption("svUnit.excludeList"), pos = .GlobalEnv,
+ loadPackages = FALSE) {
+ # List unit test (1) in loaded packages (2) in objects in pos and (3) in
+ # directories, possibly filtering them using an exclusion list
+ # Note: Komodo should list test unit files in loaded projects too!
+ if (length(packages) < 1)
+ stop("'package' cannot have zero length")
+ if (length(objects) < 1)
+ stop("'objects' cannot have zero length")
+
+ items <- character()
+
+ # 1) Unit test files in loaded packages
+ if (packages[1] != FALSE) {
+ if (is.character(packages)) { # We assume it is a list of packages
+ Pkgs <- packages
+ } else { # We use the list of all loaded packages
+ Pkgs <- .packages()
+ }
+ for (Pkg in Pkgs) {
+ # Look for test units in the package
+ path <- system.file(package = Pkg, "unitTests")
+ if (path != "" && file.info(path)$isdir) {
+ pkgname <- paste("package", Pkg, sep = ":")
+ items <- c(items, pkgname)
+ Files <- list.files(path = path, full.names = TRUE)
+ for (File in Files) { # Add all subdirectories too
+ if (file.info(File)$isdir)
+ items <- c(items, paste(pkgname, " (", basename(File),
+ ")", sep = ""))
+ }
+ }
+ }
+ }
+
+ # 2) Tests embedded in objects located in 'pos' environment
+ if (objects[1] != FALSE) {
+ envir = as.environment(pos)
+ if (is.character(objects)) {
+ tests <- character()
+ for (Oname in objects) {
+ if (exists(Oname, envir = envir, inherits = FALSE)) {
+ Obj <- get(Oname, envir = envir, inherits = FALSE)
+ if (is.svTest(Obj)) {
+ tests <- c(tests, Oname)
+ } else if (is.test(Obj)) {
+ tests <- c(tests, paste("test(", Oname, ")", sep = ""))
+ }
+ }
+ }
+ } else { # We list all objects in pos
+ Objs <- mget(ls(envir = envir), envir = envir)
+ Onames <- names(Objs)
+ tests <- character()
+ if (length(Objs) > 0) {
+ for (i in 1:length(Objs)) {
+ if (is.svTest(Objs[[i]])) {
+ tests <- c(tests, Onames[i])
+ } else if (is.test(Objs[[i]])) {
+ tests <- c(tests, paste("test(", Onames[i], ")", sep = ""))
+ }
+ }
+ }
+ }
+ items <- c(items, sort(tests))
+ }
+
+ # 3) Additional directories (check that they are valid and existing dirs)
+ if (!is.null(dirs)) {
+ # Check if each entry exists as a directory, exclude it if not
+ # Prepend "dir:" to tag them as additional directories
+ Dirs <- character()
+ for (Dir in dirs)
+ if (file.exists(Dir) && file.info(Dir)$isdir)
+ Dirs <- c(Dirs, paste("dir", Dir, sep = ":"))
+ items <- c(items, sort(Dirs))
+ }
+
+ # Filter the resulting list with 'excludeList'
+ if (!is.null(excludeList)) {
+ for (pattern in excludeList)
+ items <- items[regexpr(pattern, items) == -1]
+ }
+
+ # Do we load the package?
+ if (loadPackages) {
+ # Get a list of packages we need for the suite
+ Pkgs <- items[regexpr("^package:", items)]
+ PkgsSrch <- unique(sub(" +\\(.+$", "", Pkgs))
+ l <- length(PkgsSrch)
+ if (l > 0) {
+ PkgsName <- sub("^package:", "", PkgsSrch)
+ Search <- search()
+ for (i in 1:l) {
+ if (!PkgsSrch[i] %in% Search) {
+ res <- try(library(PkgsName[i], character.only = TRUE),
+ silent = TRUE)
+ if (inherits(res, "try-error"))
+ warning("Cannot load package '", PkgsName[i], "'")
+ }
+ }
+ }
+ }
+
+ # Make it a 'svSuite' object subclassing 'character'
+ class(items) <- c("svSuite", "character")
+ return(items)
+}
+
+makeUnit.svSuite <-
+function(x, name = make.names(deparse(substitute(x))), dir = tempdir(),
+objfile = "", codeSetUp = NULL, codeTearDown = NULL, pos = .GlobalEnv, ...) {
+ # Take an 'svSuite' object and make a unit from its function tests
+ # that are not written yet in a test unit in a file
+ # They are saved in a file named runit<name>.R in 'dir'
+ if (!is.svSuite(x))
+ stop("'x' must be a 'svSuite' object")
+ name <- as.character(name)[1]
+ # Collect all items that are not 'package:...' or 'dir:...'
+ isObj <- regexpr("^[package:|dir:]", x) == -1
+ Objs <- sub("^test[(](.+)[)]$", "\\1", x[isObj])
+ if (length(Objs) == 0) { # No objects, return NULL
+ return(NULL)
+ } else { # Make a sourceable test unit file with tests collected in Objs
+ Unit <- .prepareUnit(name, dir)
+ .writeSetUp(unit = Unit, file = objfile, code = codeSetUp)
+ .writeTearDown(unit = Unit, code = codeTearDown)
+ for (objname in Objs)
+ .writeTest(unit = Unit, objname = objname, pos = pos)
+ }
+ return(Unit)
+}
+
+runTest.svSuite <-
+function(x, name = make.names(deparse(substitute(x))), ...) {
+ # Compile and run the test for this 'svSuite' object
+ if (!is.svSuite(x))
+ stop("'x' must be a 'svSuite' object")
+ name <- as.character(name[1])
+
+ # Decode tests contained in x
+ tests <- as.character(x)
+ dirs <- character()
+ # Package suites...
+ isPkg <- regexpr("^package:", tests) > -1
+ if (any(isPkg)) {
+ Pkgs <- tests[isPkg]
+ Subdirs <- sub("^.+[(](.+)[)] *$", "\\1", Pkgs)
+ Subdirs[Subdirs == Pkgs] <- ""
+ Pkgs <- sub("^package:([^ ]+).*$", "\\1", Pkgs)
+ for (i in 1:length(Pkgs)) {
+ dir <- system.file(package = Pkgs[i], "unitTests", Subdirs[i])
+ if (dir != "") dirs <- c(dirs, dir)
+ }
+ }
+
+ # Add directories, and possibly make a temporary unit for test objects
+ if (any(!isPkg)) {
+ tests <- tests[!isPkg]
+ # Directories
+ isDir <- regexpr("^dir:", tests) > -1
+ if (any(isDir))
+ dirs <- c(sub("^dir:", "", tests[isDir]), dirs)
+ # Objects
+ if (any(!isDir)) {
+ # make a temporary unit for the tests of these objects
+ if (!is.null(Unit <- makeUnit(x, name = name))) {
+ # Add this path to dirs
+ dirs <- c(dirname(Unit), dirs)
+ }
+ }
+ }
+
+ # Now, list all files in these dirs with name being runit*.R
+ files <- character()
+ for (dir in dirs)
+ files <- c(files, list.files(dir, pattern = "^runit.+\\.[rR]$",
+ full.names = TRUE))
+ if (length(files) == 0) return(NULL) # Nothing to run!
+ # Run this test suite now, that is, source each file in .TestSuiteEnv
+ # and run each testxxx function in it, using .setUp and .tearDown too
+ # Record the list of tests
+ .lastSuite <- list()
+ for (file in files)
+ .lastSuite[[basename(file)]] <- list(file = file)
+ .Log <- Log()
+ .Log$.lastSuite <- .lastSuite
+
+ # Source each runit*.R file in turn
+ for (unit in names(.lastSuite)) {
+ # Create a new environment for this suite (created in .GlobalEnv so
+ # that we can inspect it in case of stop on error)
+ .TestSuiteEnv <<- new.env(parent = .GlobalEnv)
+ # Source the corresponding file
+ Unit <- .lastSuite[[unit]]$file
+ sys.source(Unit, envir = .TestSuiteEnv)
+ # Make sure there are .setUp() and .tearDown() functions
+ if (!exists(".setUp", envir = .TestSuiteEnv, mode = "function",
+ inherits = FALSE))
+ .TestSuiteEnv$.setUp <- function() {}
+ if (!exists(".tearDown", envir = .TestSuiteEnv, mode = "function",
+ inherits = FALSE))
+ .TestSuiteEnv$.tearDown <- function() {}
+ # List all test files in the unit
+ tests <- ls(.TestSuiteEnv, pattern = "^test.+$")
+ # Keep only 'test*' objects that are function
+ keep <- unlist(lapply(tests, function(n) exists(n,
+ envir = .TestSuiteEnv, mode = "function", inherits = FALSE)))
+ tests <- tests[keep]
+ .Log$.lastSuite[[unit]]$tests <- tests
+ # Run each test in turn
+ for (test in tests) {
+ .runTest(envir = .TestSuiteEnv, test = test, unit = Unit)
+ }
+ }
+ return(invisible(files))
+}
Added: pkg/svUnit/R/svSuiteData.R
===================================================================
--- pkg/svUnit/R/svSuiteData.R (rev 0)
+++ pkg/svUnit/R/svSuiteData.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,121 @@
+is.svSuiteData <-
+function (x) {
+ # It this a svSuiteData object
+ return(inherits(x, "svSuiteData"))
+}
+
+stats.svSuiteData <-
+function (object, ...) {
+ if (!is.svSuiteData(object))
+ stop("'object' must inherit from 'svSuiteData'")
+ # Get the list of tests
+ Tests <- ls(object)
+ if (length(Tests) == 0) {
+ # The object is empty!
+ Res <- data.frame(kind = .kind(logical()), timing = numeric(),
+ time = numeric(), unit = character(), tag = character(),
+ msg = character(), stringsAsFactors = FALSE)
+ } else {
+ # Functions to get data for each test
+ getKind <- function(x) .kindMax(x$kind)
+ getTiming <- function(x) attr(x, "stats")["timing"]
+ getTime <- function(x) attr(x, "time")
+ getContext <- function(x, item) attr(x, "context")[[item]]
+ Res <- data.frame(
+ kind = rev(sapply(object, getKind)),
+ timing = rev(sapply(object, getTiming)),
+ time = structure(rev(sapply(object, getTime)),
+ class = c("POSIXt", "POSIXct")),
+ unit = rev(sapply(object, getContext, "unit")),
+ msg = rev(sapply(object, getContext, "msg")),
+ stringsAsFactors = FALSE)
+ }
+ return(Res)
+}
+
+metadata <-
+function (object, ...)
+ UseMethod("metadata")
+
+metadata.svSuiteData <-
+function (object, fields = c("R.version", "sessionInfo", "time", "description"),
+...) {
+ # Extract metadata information from a 'svSuiteData' object
+ if (!is.svSuiteData(object))
+ stop("'object' must inherit from 'svSuiteData'")
+ # Return a list with all metadata elements found
+ fields <- paste(".", fields, sep = "")
+ Res <- list()
+ for (F in fields)
+ Res[[F]] <- object[[F]]
+ return(Res)
+}
+
+print.svSuiteData <-
+function (x, all = FALSE, file = "", append = FALSE, ...) {
+ if (!is.svSuiteData(x))
+ stop("'x' must inherit from 'svSuiteData'")
+ Tests <- ls(x)
+ if (length(Tests) == 0) {
+ cat("No test records!\n", file = file, append = append)
+ } else {
+ # Print general information about the tests
+ Stats <- stats(x)
+ Tests <- rownames(Stats) # To make sure we use the same!
+ Timing <- .formatTime(sum(Stats$timing, na.rm = TRUE), secDigits = 1)
+ cat("= A svUnit test suite", Timing, " with:\n\n", sep = "",
+ file = file, append = append)
+ cat(paste("* ", Tests, " ... ", as.character(Stats$kind), "",
+ sep = "", collapse = "\n"),
+ "\n\n", sep = "", file = file, append = TRUE)
+
+ # Print detailed information about each test
+ for (Test in Tests)
+ print(x[[Test]], all = all, file = file, append = TRUE, ...)
+ }
+ return(invisible(x))
+}
+
+summary.svSuiteData <-
+function (object, ...)
+ protocol_text.svSuiteData(object, ...)
+
+protocol <-
+function (object, type = "text", file = "", append = FALSE, ...)
+ UseMethod("protocol")
+
+protocol.default <-
+function (object, type = "text", file = "", append = FALSE, ...)
+ get(paste("protocol", type[1], sep = "_"))(object, file = file, append = append, ...)
+
+protocol.svSuiteData <-
+function (object, type = "text", file = "", append = FALSE, ...)
+ get(paste("protocol", type[1], sep = "_"))(object, file = file, append = append, ...)
+
+protocol_text <-
+function (object, file = "", append = FALSE, ...)
+ UseMethod("protocol_text")
+
+protocol_text.svSuiteData <-
+function (object, file = "", append = FALSE, ...) {
+ if (!is.svSuiteData(object))
+ stop("'object' must inherit from 'svSuiteData'")
+ Tests <- sort(ls(object))
+ if (length(Tests) == 0) {
+ cat("No test records!\n", file = file, append = append)
+ } else {
+ # Print general information about the tests
+ Stats <- stats(object)
+ Tests <- rownames(Stats) # To make sure we use the same!
+ Timing <- .formatTime(sum(Stats$timing, na.rm = TRUE), secDigits = 1)
+ cat("= A svUnit test suite", Timing, " with:\n\n", sep = "",
+ file = file, append = append)
+ cat(paste("* ", Tests, " ... ", as.character(Stats$kind), "",
+ sep = "", collapse = "\n"),
+ "\n\n", sep = "", file = file, append = TRUE)
+
+ # Summarize each test
+ for (Test in Tests)
+ summary(object[[Test]], file = file, append = TRUE)
+ }
+}
Modified: pkg/svUnit/R/svTest.R
===================================================================
--- pkg/svUnit/R/svTest.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/R/svTest.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,16 +1,24 @@
svTest <-
function (testFun) {
# Create a 'svTest' object, using testFun: a function without arguments
+ # that contains one or more checkXX() assertions
if (!is.function(testFun))
stop("'testFun' must be a function or a 'svTest' object")
# Check that there are no arguments
if (length(formals(testFun)) > 0)
stop("'testFun' must be a function without any arguments")
- # This is a S3 object of class 'svTest'
- class(testFun) <- "svTest"
+ # This is a S3 object of class 'svTest', subclassing 'function'
+ class(testFun) <- c("svTest", "function")
return(testFun)
}
+print.svTest <-
+function (x, ...) {
+ cat("svUnit test function:\n")
+ print(body(x))
+ return(invisible(x))
+}
+
as.svTest <-
function (x) {
# Coercion to a 'svTest' object
@@ -25,8 +33,8 @@
is.test <-
function (x) {
- # Is this a test object (indeed a 'svTest' one)
- # or do this object contain a non NULL 'test' attribute
+ # Is this a 'svTest'object
+ # or do this object contain a non NULL 'test' attribute?
return(is.svTest(x) || !is.null(attr(x, "test")))
}
@@ -37,93 +45,75 @@
if (is.svTest(x)) {
return(x)
} else {
- return(attr(x, "test"))
+ res <- attr(x, "test")
+ if (is.null(res)) {
+ # Create a dummy test with only a DEACTIVATED entry
+ res <- svTest(function() DEACTIVATED("Object has no tests!"))
+ }
+ return(res)
}
}
`test<-` <-
function (x, value) {
- # Add 'value' as a 'test' attribute to 'x' after coercing to 'svTest'
+ # Add 'value' as a 'test' attribute to 'x' after coercing it to 'svTest'
attr(x, "test") <- as.svTest(value)
return(x)
}
makeUnit <-
-function(x, ...)
+function (x, ...)
UseMethod("makeUnit")
makeUnit.default <-
-function(x, name = make.names(deparse(substitute(x))), dir = tempdir(), ...) {
+function (x, name = make.names(deparse(substitute(x))), dir = tempdir(),
+objfile = "", codeSetUp = NULL, codeTearDown = NULL, ...) {
# Take an object and make a unit from the tests it contains
- # It is saved in a file runit.<name>.R in 'dir'
- name <- as.character(name[1])
- dir <- as.character(dir[1])
- # Check that dir exists (do not create it!)
- if (!file.exists(dir) || !file.info(dir)$isdir)
- stop("'dir' must be an existing directory")
-
- Unit <- file.path(dir, paste("runit", name, "R", sep = "."))
- cat("# Test unit '", name, "'\n", sep = "", file = Unit)
-
+ # It is saved in a file runit<name>.R in 'dir'
+ name <- as.character(name)[1]
+ name <- sub("^test\\.(.+)\\.$", "\\1", name)
+ Unit <- .prepareUnit(name, dir)
# Just get the test from the object
Test <- test(x)
- # Make sure the name start with "test."
- if (regexpr("^test\\.", name) > -1) testname <- name else
- testname <- paste("test", name, sep = ".")
- testname <- make.names(testname)
- cat('\n"', testname, '" <-\n', sep = "", file = Unit, append = TRUE)
- if (is.null(Test)) {
- # Create a dummy test with DEACTIVATED entry
- body <- c(
- 'function() {',
- paste('\tDEACTIVATED("Object', deparse(substitute(x)), 'has no tests!")'),
- '}\n')
- } else {
- capture.body <-
- function(Data) {
- rval <- NULL
- File <- textConnection("rval", "w", local = TRUE)
- sink(File)
- on.exit({ sink(); close(File) })
- dput(Data, file = File, control = "useSource")
- on.exit()
- sink()
- close(File)
- return(rval)
- }
- body <- capture.body(Test)
- }
- cat(body, sep = "\n", file = Unit, append = TRUE)
-
+ # Make required initialisation to allow locating objects
+ .writeSetUp(unit = Unit, file = objfile, code = codeSetUp)
+ .writeTearDown(unit = Unit, code = codeTearDown)
+ # Write the test function in the file
+ .writeTest(unit = Unit, objname = name, obj = x)
+ # Return the name of the test function
return(Unit)
}
makeUnit.svTest <-
-function(x, name = make.names(deparse(substitute(x))), dir = tempdir(), ...)
- return(makeUnit.default(x, name = name, dir = dir, ...))
+function (x, name = make.names(deparse(substitute(x))), dir = tempdir(),
+objfile = "", codeSetUp = NULL, codeTearDown = NULL, ...) {
+ # I know: this is not needed, but it is there in case additional work
+ # would be needed in the future, and also to show that makeUnit is
+ # designed to work on 'svTest' objects
+ return(makeUnit.default(x, name = name, dir = dir, objfile = objfile,
+ codeSetUp = codeSetUp, codeTearDown = codeTearDown, ...))
+}
runTest <-
-function(x, ...)
+function (x, ...)
UseMethod("runTest")
runTest.default <-
-function(x, name = make.names(deparse(substitute(x))), ...) {
+function (x, name = deparse(substitute(x)), objfile = "", tag = "", msg = "",
+...) {
# Run the test for the 'test' attribute of this object
- Test <- test(x)
- if (is.null(Test) || !inherits(Test, "svTest"))
- Test <- svTest(function () DEACTIVATED("Object has no tests!"))
- return(runTest(Test, name = name, ...))
+ name <- paste("test(", name, ")", sep = "")
+ return(runTest(test(x), name = name, objfile = objfile, tag = tag, msg = msg, ...))
}
runTest.svTest <-
-function(x, name = make.names(deparse(substitute(x))), ...) {
- # Make a test unit with the test data
- Unit <- makeUnit(x, name = name, ...)
- if (is.null(Unit)) return(NULL) # No tests to run!
- # Make sure that the temporary test unit file is destroyed when done
- on.exit(unlink(Unit))
-
- # Run the tests now
- res <- runUnit(name = name, dirs = dirname(Unit), ...)
- return(res)
+function (x, name = deparse(substitute(x)), objfile = "", tag = "", msg = "",
+...) {
+ if (!is.svTest(x))
+ stop("'x' must be a 'svTest' object")
+ # Names of object and test
+ test <- as.character(name)[1]
+ test <- .runTest(x, test = test, objfile = objfile, tag = tag, msg = msg)
+ .Log <- Log()
+ return(invisible(.Log[[test]]))
}
Added: pkg/svUnit/R/svTestData.R
===================================================================
--- pkg/svUnit/R/svTestData.R (rev 0)
+++ pkg/svUnit/R/svTestData.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,85 @@
+is.svTestData <-
+function (x) {
+ # It this a svTestData object
+ return(inherits(x, "svTestData"))
+}
+
+stats <-
+function (object, ...)
+ UseMethod("stats")
+
+stats.svTestData <-
+function (object, ...) {
+ if (!is.svTestData(object))
+ stop("'object' must inherit from 'svTestData'")
+ Stats <- attr(object, "stats")
+ Table <- table(object$kind)
+ # Update the table with the total number of test
+ Kinds <- c(Stats["tests"] - sum(Table[2:4], na.rm = TRUE), Table[2:4])
+ names(Kinds) <- names(Table)
+ # Return a list with the table of kinds and the total timing
+ return(list(kind = Kinds, timing = Stats["timing"]))
+}
+
+print.svTestData <-
+function (x, all = FALSE, header = TRUE, file = "", append = FALSE, ...) {
+ # If there is a context attribute, print info about the tests
+ cat("", file = file, append = append)
+ Context <- attr(x, "context")
+ if (!is.null(Context)) {
+ unitStr <- if (Context["unit"] == "") "" else
+ paste(" (in ", basename(Context["unit"]), ")", sep = "")
+ Stats <- stats(x)
+ if (isTRUE(header))
+ cat("\n== ", Context["test"], unitStr, .formatTime(Stats$timing,
+ secDigits = 1), ": ", as.character(.kindMax(x$kind)), "\n",
+ Context["msg"], "\n", sep = "", file = file, append = TRUE)
+ cat(paste(c("//Pass:", "Fail:", "Errors:"), Stats$kind[1:3],
+ collapse = " "), "//\n\n", sep = "", file = file, append = TRUE)
+ # Don't print tests that succeed if !all
+ if (!isTRUE(all)) X <- x[x$kind != "OK", ] else X <- x
+ } else X <- x
+ # Print info about each individual filtered test
+ if (nrow(X) > 0) {
+ Res <- ifelse(X$res == "", "", paste("\n", X$res, sep = ""))
+ cat(paste("* ", X$msg, ": ", X$call, .formatTime(X$timing,
+ secDigits = 3), " ... ", as.character(X$kind), Res, sep = "",
+ collapse = "\n"), file = file, append = TRUE)
+ }
+ return(invisible(x))
+}
+
+summary.svTestData <-
+function (object, header = TRUE, file = "", append = FALSE, ...) {
+ # If there is a context attribute, print info about the tests
+ cat("", file = file, append = append)
+ Context <- attr(object, "context")
+ if (!is.null(Context)) {
+ unitStr <- if (Context["unit"] == "") "" else
+ paste(" (in ", basename(Context["unit"]), ")", sep = "")
+ Stats <- stats(object)
+ if (isTRUE(header))
+ cat("\n== ", Context["test"], unitStr, .formatTime(Stats$timing,
+ secDigits = 1), ": ", as.character(.kindMax(object$kind)), "\n",
+ Context["msg"], "\n", sep = "", file = file, append = TRUE)
+ cat(paste(c("//Pass:", "Fail:", "Errors:"), Stats$kind[1:3],
+ collapse = " "), "//\n\n", sep = "", file = file, append = TRUE)
+ }
+ # List tests that failed
+ Items <- rownames(object)
+ Fail <- object$kind == "**FAILS**"
+ if (any(Fail)) {
+ cat("=== Failures\n", file = file, append = TRUE)
+ cat(paste("[", Items[Fail], "] ", object$msg[Fail], ": ",
+ object$call[Fail], collapse = "\n", sep = ""), "\n\n",
+ sep = "", file = file, append = TRUE)
+ }
+ # List tests that give errors
+ Err <- object$kind == "**ERROR**"
+ if (any(Err)) {
+ cat("=== Errors\n", file = file, append = TRUE)
+ cat(paste("[", Items[Err], "] ", object$msg[Err], ": ",
+ object$call[Err], collapse = "\n", sep = ""), "\n\n",
+ sep = "", file = file, append = TRUE)
+ }
+}
Added: pkg/svUnit/R/svUnit-internal.R
===================================================================
--- pkg/svUnit/R/svUnit-internal.R (rev 0)
+++ pkg/svUnit/R/svUnit-internal.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,422 @@
+.onLoad <-
+function (lib, pkg) {
+ # The default exclusion list, if it is not defined yet
+ # Although there are unit tests defined in these packages (as examples),
+ # we don't want to include them, by default, in our test suite!
+ if (is.null(getOption("svUnit.excludeList")))
+ options(svUnit.excludeList = c("package:sv", "package:RUnit"))
+ # Look if the SciViews-K Unit Komodo extension is installed
+ .installUpgradeKomodoExtension()
+ # Install a callback to update the list of units automatically in the GUI
+ .assignTemp(".taskCallbackId", addTaskCallback(guiSuiteAutoList))
+}
+
+.onUnload <-
+function (libpath) {
+ # Delete the taskCallback
+ taskCallbackId <- .getTemp(".taskCallbackId", NULL)
+ if (!is.null(taskCallbackId)) removeTaskCallback(taskCallbackId)
+ # and clear the list of units in the GUI client
+ if (exists("koCmd", mode = "function"))
+ get("koCmd")('sv.r.unit.getRUnitList_Callback("");')
+}
+
+.packageName <- "svUnit"
+
+.komodoExtensionMinVersion <- "0.6.0"
+
+.installUpgradeKomodoExtension <-
+function () {
+ if (!exists("koCmd", mode = "function")) return()
+ # Look if the SciViews-K Unit Komodo extension is installed and is of the
+ # right version. Otherwise, propose to install, or update it
+ xpiFile <- system.file("komodo", "sciviewskunit-ko.xpi", package = "svUnit")
+ koVersion <- get("koCmd")('sv.socket.serverWrite(sv.r.unit.version + "." + sv.r.unit.release);')
+ if (inherits(koVersion, "try-error")) {
+ # We need to install the extension
+ cmd <- 'var res = ko.dialogs.okCancel("The SciViews-K Unit extension is required by svUnit",'
+ cmd <- paste(cmd, '"OK", "Do you want to install the SciViews-K Unit extension now in Komodo?')
+ cmd <- paste(cmd, 'You will be prompted for confirmation (click \'Install Now\')')
+ cmd <- paste(cmd, 'and will have to restart Komodo at the end of the installation')
+ cmd <- paste(cmd, '(click \'Restart Komodo\').", "svUnit");')
+ cmd <- paste(cmd, ' if (res == "OK") { ko.open.URI("<<<data>>>"); }', sep = "")
+ get("koCmd")(cmd, data = xpiFile)
+ } else if (.compareVersion(koVersion, .komodoExtensionMinVersion) == -1) {
+ # We need to upgrade the extension
+ cmd <- 'var res = ko.dialogs.okCancel("A newer SciViews-K Unit extension is required by svUnit",'
+ cmd <- paste(cmd, '"OK", "Your SciViews-K Unit extension is too old for this version of svUnit.')
+ cmd <- paste(cmd, 'Do you want to upgrade it now?')
+ cmd <- paste(cmd, 'You will be prompted for confirmation (click \'Install Now\')')
+ cmd <- paste(cmd, 'and will have to restart Komodo at the end of the installation')
+ cmd <- paste(cmd, '(click \'Restart Komodo\').", "svUnit");')
+ cmd <- paste(cmd, ' if (res == "OK") { ko.open.URI("<<<data>>>"); }', sep = "")
+ get("koCmd")(cmd, data = xpiFile)
+ }
+}
+
+.compareVersion <-
+function (a, b) {
+ # This is the same as compareVersion() in utils, but we don't want dependencies on utils
+ if (is.na(a))
+ return(-1)
+ if (is.na(b))
+ return(1)
+ a <- as.integer(strsplit(a, "[\\.-]")[[1]])
+ b <- as.integer(strsplit(b, "[\\.-]")[[1]])
+ for (k in 1:length(a)) {
+ if (k <= length(b)) {
+ if (a[k] > b[k])
+ return(1)
+ else if (a[k] < b[k])
+ return(-1)
+ }
+ else {
+ return(1)
+ }
+ }
+ if (length(b) > length(a))
+ return(-1)
+ else return(0)
+}
+
+.kindLevels <- c("OK", "**FAILS**", "**ERROR**", "DEACTIVATED")
+
+.kind <-
+function (val = TRUE) {
+ # TRUE or 1 -> 1 = "OK"
+ # FALSE or 0 -> 2 = "**FAILS**"
+ # -1 -> 3 = "**ERROR**"
+ # -2 -> 4 = "DEACTIVATED"
+ factor(.kindLevels[-(as.integer(val) - 2)], levels = .kindLevels)
+}
+
+.kindMax <-
+function (kinds) {
+ # If there are no record, must be because all tests succeed!
+ if (length(kinds) == 0) return(.kind(TRUE))
+ Kinds <- as.numeric(kinds)
+ if (sum(Kinds, na.rm = TRUE) == 0) return(.kind(NA))
+ factor(.kindLevels[max(as.numeric(kinds), na.rm = TRUE)],
+ levels = .kindLevels)
+}
+
+.formatTime <-
+function (x, secDigits = 0, minSec = 10^-secDigits, prepend = " run in") {
+ # x is given in seconds, and it returns a pretty formatted string with time
+ if (is.null(x) || is.na(x)[1]) return("")
+ x <- as.numeric(x)
+ Sec <- round(x %% 60, digits = secDigits)
+ Min <- x %/% 60
+ Hour <- Min %/% 60
+ Min <- Min %% 60
+ Time <- prepend
+ Time <- ifelse (Hour > 0, paste(Time, Hour, "h"), Time)
+ Time <- ifelse (Min > 0 | Time != prepend, paste(Time, Min, "min"), Time)
+ Time <- ifelse (Sec > minSec | Time != prepend, paste(Time, Sec, "sec"), Time)
+ Time <- ifelse (Time == prepend, paste(prepend, "less than", minSec, "sec"), Time)
+ Time[is.na(Time)] <- ""
+ return(Time)
+}
+# Test: .formatTime((0:10)*400 + 0.56)
+
+.formatResult <-
+function (result, level = getOption("svUnit.strLevel")) {
+ if (is.null(level)) level <- 1 else level <- as.integer(level[1])
+ if (level < 1) return("") # Return an empty string
+ # Capture the report returned by the str() function
+ capture.str <- function(data, level) {
+ rval <- NULL
+ file <- textConnection("rval", "w", local = TRUE)
+ sink(file, type = "output")
+ sink(file, type = "message")
+ on.exit({
+ sink(type = "output")
+ sink(type = "message")
+ close(file)
+ })
+ str(data, max.level = level)
+ cat("\n")
+ return(rval)
+ }
+ Str <- capture.str(result, level)
+ return(paste(Str, collapse = "\n"))
+}
+
+.logTest <-
+function (timing, test, msg = "", description = NULL) {
+ .Log <- Log(description = description)
+ # Determine the name of the test
+ if (missing(test)) { # Is it defined globally?
+ if (exists("..Test", envir = .Log, inherits = FALSE)) {
+ test <- .Log$..Test
+ } else { # Try to guess it from the call
+ ret <- try(test <- as.character(sys.call(-2))[1], silent = TRUE)
+ if (inherits(ret, "try-error") || is.na(test)) {
+ # check...() probably called directly at the command line
+ test <- "eval" # This is convenient for collecting these tests
+ # together with tests run directly inside runit*.R files (tests
+ # not embedded in test functions)
+ } else if (test == "runTest") {
+ # Special case for runTest(myTest) or runTest(test(foo))
+ test <- as.character(sys.call(-2))[2]
+ } else if (test == "eval.with.vis") {
+ test <- "eval"
+ }
+ }
+ }
+ # Do we need to create 'test'?
+ if (!exists(test, envir = .Log, inherits = FALSE)) {
+ if (msg == "") msg <- .Log$..Msg
+ .Log[[test]] <- structure(
+ data.frame(
+ msg = character(),
+ call = character(),
+ timing = numeric(),
+ kind = .kind(logical()),
+ res = character(),
+ obj = character(),
+ file = character(),
+ tag = character(),
+ stringsAsFactors = FALSE),
+ time = Sys.time(),
+ stats = c(tests = 1, timing = timing),
+ context = c(unit = as.character(.Log$..Unit), test = test,
+ msg = paste(msg, collapse = "\n")),
+ class = c("svTestData", "data.frame"))
+ } else {
+ # Just update stats
+ attr(.Log[[test]], "stats") <-
+ attr(.Log[[test]], "stats") + c(1, timing)
+ }
+ return(test)
+}
+
+.logTestData <-
+function (test, msg, call, timing, val, kind = .kind(val), res,
+obj = .Log$..Obj, file = .Log$..File, tag = .Log$..Tag,
+printTest = getOption("svUnit.printTest")) {
+ # Add these data to .lastTest
+ .Log$.lastTest <- structure(data.frame(
+ msg = msg, call = call, timing = timing, kind = kind, res = res,
+ obj = obj, file = file, tag = tag, stringsAsFactors = FALSE),
+ class = c("svTestData", "data.frame"),
+ row.names = as.character(attr(.Log[[test]], "stats")["tests"]))
+ # Add them also to the log of my test
+ .Log[[test]][nrow(.Log[[test]]) + 1, ] <- .Log$.lastTest
+ # Do we print detailed results for this test?
+ if (is.null(printTest)) printTest <- !interactive() # Guess it from context
+ if (isTRUE(printTest)) print(.Log$.lastTest)
+}
+
+.prepareUnit <-
+function (name, dir) {
+ # Prepare for writing a test unit file
+ dir <- as.character(dir)[1]
+ # Check that dir exists (do not create it!)
+ if (!file.exists(dir) || !file.info(dir)$isdir)
+ stop("'dir' must be an existing directory")
+ # If dir is tempdir(), then, make sure there are no other runit*.R files
+ # left (should not!) - One can store only one unit at a time in tempdir()!
+ if (dir == tempdir()) {
+ runitfiles <- list.files(dir, pattern = "^runit.*\\.[r|R]$",
+ full.names = TRUE)
+ unlink(runitfiles)
+ }
+ Unit <- file.path(dir, paste("runit", name, ".R", sep = ""))
+ cat("## Test unit '", name, "'\n", sep = "", file = Unit)
+ return(Unit)
+}
+
+.writeSetUp <-
+function (unit, file = "", msg = "", tag = "", code = NULL) {
+ # Write the .setUp() function in the test unit file
+ # Here, we write a context to localize tested objects and test unit files
+ catUnit <- function(...) cat(..., sep = "", file = unit, append = TRUE)
+ catUnit('\n.setUp <-\n')
+ catUnit('function () {\n')
+ catUnit('\t## Specific actions for svUnit: prepare context\n')
+ catUnit('\tif ("package:svUnit" %in% search()) {\n')
+ catUnit('\t\t.Log <- Log() ## Make sure .Log is created\n')
+ catUnit('\t\t.Log$..Unit <- "', unit, '"\n')
+ catUnit('\t\t.Log$..File <- "', as.character(file)[1], '"\n')
+ catUnit('\t\t.Log$..Obj <- ""\n')
+ catUnit('\t\t.Log$..Tag <- "', tag, '"\n')
+ catUnit('\t\t.Log$..Msg <- "', paste(msg, collapse = "\n"), '"\n')
+ catUnit('\t\trm(..Test, envir = .Log)\n')
+ catUnit('\t}\n')
+ if (!is.null(code)) catUnit(paste("\t", code, collapse = "\n"))
+ catUnit('}\n')
+}
+
+.writeTearDown <-
+function (unit, code = NULL, rm.unit = TRUE, rm.file = TRUE) {
+ # Write the .tearDown() function in the test unit file
+ # Here, we undo what was done in .setUp()
+ catUnit <- function(...) cat(..., sep = "", file = unit, append = TRUE)
+ catUnit('\n.tearDown <-\n')
+ catUnit('function () {\n')
+ if (!is.null(code)) catUnit(paste("\t", code, collapse = "\n"))
+ catUnit('\t## Specific actions for svUnit: clean up context\n')
+ catUnit('\tif ("package:svUnit" %in% search()) {\n')
+ catUnit('\t\t.Log$..Unit <- ""\n')
+ catUnit('\t\t.Log$..File <- ""\n')
+ catUnit('\t\t.Log$..Obj <- ""\n')
+ catUnit('\t\t.Log$..Tag <- ""\n')
+ catUnit('\t\t.Log$..Msg <- ""\n')
+ catUnit('\t\trm(..Test, envir = .Log)\n')
+ catUnit('\t}\n')
+ catUnit('}\n')
+}
+
+.writeTest <-
+function (unit, objname, pos = .GlobalEnv, obj = NULL) {
+ # Make sure that the name of a test function is syntactically correct
+ # and starts with 'test'
+ if (regexpr("^test", objname) > -1) {
+ testname <- objname
+ } else {
+ testname <- paste("test", objname, sep = "")
+ }
+ # Write the first line in the file
+ catUnit <- function(...) cat(..., file = unit, append = TRUE)
+ catUnit('\n"', testname, '" <-\n', sep = "")
+ # Get the object
+ if (missing(obj)) {
+ # Look for 'objname' in 'pos'
+ if (!exists(objname, where = pos)) {
+ Test <- ""
+ } else {
+ Test <- test(get(objname, pos = pos))
+ }
+ } else {
+ Test <- test(obj)
+ }
+ if (is.character(Test)) {
+ # Create a dummy test with DEACTIVATED entry indicating missing object
+ body <- c(
+ 'function() {',
+ paste('\tDEACTIVATED("Object', objname, 'not found!")'),
+ '}\n')
+ } else if (is.null(Test)) {
+ # Create a dummy test with DEACTIVATED entry indicating missing test
+ body <- c(
+ 'function() {',
+ paste('\tDEACTIVATED("Object', objname, 'has no tests!")'),
+ '}\n')
+ } else {
+ # Get the body of the test function
+ capture.body <- function(Data) {
+ rval <- NULL
+ File <- textConnection("rval", "w", local = TRUE)
+ sink(File)
+ on.exit({ sink(); close(File) })
+ dput(Data, file = File, control = "useSource")
+ on.exit()
+ sink()
+ close(File)
+ return(rval)
+ }
+ body <- capture.body(Test)
+ }
+ # Write the boby of the test function in the file
+ catUnit(body, sep = "\n")
+}
+
+.runTest <-
+function (x, envir, test, objfile = "", unit = "", tag = "", msg = "") {
+ # Run one test in a protected environment catching errors and warnings
+ # and preparing a suitable context
+ name <- sub("^test\\.(.+)\\.$", "\\1", test)
+
+ # The context is written in the .Log, but previous context is saved
+ # and restored on return
+ .Log <- Log() # Make sure that .Log exists, or create a new one
+ oContext <- c(Unit = .Log$..Unit, Obj = .Log$..Obj, File = .Log$..File,
+ Msg = .Log$..Msg, Tag = .Log$..Tag)
+ on.exit({
+ .Log$..Unit <- oContext[1]
+ .Log$..Obj <- oContext[2]
+ .Log$..File <- oContext[3]
+ .Log$..Msg <- oContext[4]
+ .Log$..Tag <- oContext[5]
+ })
+ .Log$..Unit <- unit # The unit file
+ .Log$..Obj <- name # Name of the tested object
+ .Log$..File <- objfile # Where is the code source of 'name'?
+ .Log$..Msg <- paste(msg, collapse = "\n") # Message for this test
+ .Log$..Tag <- tag # A tag in objfile to locate code
+ # Define the test and save possible existing definition to restore it
+ if (exists("..Test", envir = .Log, inherits = FALSE)) {
+ oTest <- .Log$..Test
+ on.exit(.Log$..Test <- oTest, add = TRUE)
+ } else on.exit(rm("..Test", envir = .Log), add = TRUE)
+ .Log$..Test <- test # Define the name of the test
+
+ if (missing(envir)) {
+ # The environment where the test is run
+ envir <- new.env(parent = .GlobalEnv)
+ envir[[test]] <- x # A copy of the test code
+ envir$.setUp <- function() {} # Fake .setUp
+ envir$.tearDown <- function() {} # Fake .tearDown
+ }
+ # We need this installed in our sandbox .TestEnv to run the test
+ envir$.LogWarnings <- list() # A list to collect warnings
+
+ # Clear the corresponding log, if it exists
+ if (exists(test, envir = .Log, inherits = FALSE))
+ rm(list = test, envir = .Log)
+
+ # Evaluate the test function in .testEnv, catching errors
+ owarn <- getOption("warn")
+ on.exit(options(warn = owarn), add = TRUE)
+ if (isTRUE(getOption("svUnit.StopOnWarning"))) nwarn <- 2 else nwarn <- -1
+ options(warn = nwarn)
+
+ # Evaluate the test function in the .TestEnv environment
+ cmd <- paste("evalq(.LogRes <- try( { .setUp(); ", test,
+ "(); .tearDown() }, silent = TRUE), envir = envir)", sep = "")
+ eval(parse(text = cmd))
+
+ # Analyze error => is it a deactivation or error in the code?
+ if (inherits(Res <- envir$.LogRes, "try-error")) {
+ # We record this as a test returning **ERROR** or DEACTIVATED
+ .logTest(0, test)
+ # Is it because we encountered a DEACTIVATED() command or something else?
+ if (regexpr("DEACTIVATED\\(", Res) > -1) {
+ Msg <- sub("^[^:]+: *", "", as.character(Res))
+ Msg <- sub("\n$", "", Msg)
+ .logTestData(test, msg = Msg, call = "", timing = NA,
+ val = -2, res = "\n")
+ } else {
+ # This is an error (something wrong with the code in the test fun)
+ .logTestData(test, msg = "", call = deparse(sys.call()),
+ timing = NA, val = -1, res = paste(Res, collapse = "\n"))
+ }
+ }
+ return(test)
+}
+
+.assignTemp <-
+function (x, value)
+ assign(x, value, envir = .TempEnv())
+
+.getTemp <-
+function (x, default = character(0)) {
+ if (exists(x, envir = .TempEnv(), inherits = FALSE)) {
+ return(get(x, envir = .TempEnv(), inherits = FALSE))
+ } else { # Variable not found, return the default value
+ return(default)
+ }
+}
+
+.TempEnv <-
+function() {
+ pos <- match("TempEnv", search())
+ if (is.na(pos)) { # Must create it
+ TempEnv <- list()
+ attach(TempEnv, pos = length(search()) - 1)
+ rm(TempEnv)
+ pos <- match("TempEnv", search())
+ }
+ return(pos.to.env(pos))
+}
Deleted: pkg/svUnit/R/svUnit.R
===================================================================
--- pkg/svUnit/R/svUnit.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/R/svUnit.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,245 +0,0 @@
-svUnit <-
-function (tests) {
- # Check provided tests and build a 'svUnit' object
- tests <- as.character(tests)
- # Remove NAs and empty strings ("") from tests
- tests <- tests[!is.na(tests) & !(tests == "")]
- if (length(tests) > 0) {
- # Tests must be character strings like:
- # * package:PKG
- # * package:PKG (TESTSUITE)
- # * dir:MYDIR
- # * test(OBJ) where OBJ is any object with a 'test' attribute
- # * OBJ being a 'svTest' object (with non "exotic" name!),
- # Syntax is checked, but not the existence/validity of corresponding tests!
- check1 <- (regexpr("^package:[a-zA-Z._]+$", tests) > -1)
- check2 <- (regexpr("^package:[a-zA-Z._]+ *\\(.+\\)$", tests) > -1)
- check3 <- (regexpr("^dir:.+", tests) > -1)
- check4 <- (regexpr("^test\\(.+\\)$", tests) > -1)
- check5 <- (regexpr("^[a-zA-Z0-9_.]+$", tests) > -1)
- wrong <- ((check1 + check2 + check3 + check4 + check5) == 0)
- if (any(wrong))
- stop("Wrong 'test' data: must be 'package:PKG', 'package:PKG (SUITE)',\n'dir:MYDIR', 'test(OBJ)' or 'OBJ'")
- }
- class(tests) <- "svUnit"
- return(tests)
-}
-
-as.svUnit <-
-function (x)
- return(svUnit(x))
-
-is.svUnit <-
-function (x)
- return(inherits(x, "svUnit"))
-
-print.svUnit <-
-function (x, ...) {
- if (!is.svUnit(x))
- stop("'x' must be a 'svUnit' object")
- if (length(x) < 1) {
- cat("An empty svUnit test suite\n")
- } else {
- cat("A svUnit test suite definition with:\n")
- # Separate unit tests from tests embedded in objects
- isSuite <- regexpr("^[package:|dir:]", x) > -1
- if (any(isSuite)) {
- Suites <- x[isSuite]
- msg <- ifelse (length(Suites) == 1, "\n- Test suite:\n",
- "\n- Test suites:\n")
- cat(msg)
- print(Suites)
- }
-
- if (any(!isSuite)) {
- Objs <- x[!isSuite]
- msg <- ifelse (length(Objs) == 1, "\n- Test function:\n",
- "\n- Test functions:\n")
- cat(msg)
- print(Objs)
- }
- }
- return(invisible(x))
-}
-
-svUnitList <-
-function (packages = TRUE, objects = TRUE, pos = .GlobalEnv) {
- # List unit test (1) in loaded packages and (2) in objects in pos
- # Note: Komodo should list test files in loaded projects too!
- if (length(packages) < 1)
- stop("'package' cannot have zero length")
- if (length(objects) < 1)
- stop("'objects' cannot have zero length")
-
- items <- character()
-
- # 1) Unit test files in loaded packages
- if (packages[1] != FALSE) {
- if (is.character(packages)) { # We assume it is a list of packages
- Pkgs <- packages
- } else { # We use the list of all loaded packages
- Pkgs <- .packages()
- }
- for (Pkg in Pkgs) {
- path <- system.file(package = Pkg, "unitTests")
- if (path != "" && file.info(path)$isdir) {
- pkgname <- paste("package", Pkg, sep = ":")
- items <- c(items, pkgname)
- Files <- list.files(path = path, full.names = TRUE)
- for (File in Files) { # Add all subdirectories too
- if (file.info(File)$isdir)
- items <- c(items, paste(pkgname, " (", basename(File),
- ")", sep = ""))
- }
- }
- }
- }
-
- # 2) Test embedded in objects located in 'pos' environment
- if (objects[1] != FALSE) {
- envir = as.environment(pos)
- if (is.character(objects)) {
- tests <- character()
- for (Oname in objects) {
- if (exists(Oname, envir = envir, inherits = FALSE)) {
- Obj <- get(Oname, envir = envir, inherits = FALSE)
- if (is.svTest(Obj)) {
- tests <- c(tests, Oname)
- } else if (is.test(Obj)) {
- tests <- c(tests, paste("test(", Oname, ")", sep = ""))
- }
- }
- }
- } else { # We list all objects in pos
- Objs <- mget(ls(envir = envir), envir = envir)
- Onames <- names(Objs)
- tests <- character()
- if (length(Objs) > 0) {
- for (i in 1:length(Objs)) {
- if (is.svTest(Objs[[i]])) {
- tests <- c(tests, Onames[i])
- } else if (is.test(Objs[[i]])) {
- tests <- c(tests, paste("test(", Onames[i], ")", sep = ""))
- }
- }
- }
- }
- items <- c(items, sort(tests))
- }
- # Make it a 'svUnit' object
- class(items) <- "svUnit"
- return(items)
-}
-
-makeUnit.svUnit <-
-function(x, name = make.names(deparse(substitute(x))), dir = tempdir(),
-pos = .GlobalEnv, ...) {
- # Take an 'svUnit' object and make a unit from its function tests
- # It is saved in a file runit.<name>.R in 'dir'
- if (!is.svUnit(x))
- stop("'x' must be a 'svUnit' object")
- name <- as.character(name[1])
- dir <- as.character(dir[1])
- # Check that dir exists (do not create it!)
- if (!file.exists(dir) || !file.info(dir)$isdir)
- stop("'dir' must be an existing directory")
-
- # Collect all items that are not 'package:...' or 'dir:...'
- isObj <- regexpr("^[package:|dir:]", x) == -1
- Objs <- sub("^test[(](.+)[)]$", "\\1", x[isObj])
- if (length(Objs) == 0) {
- # No objects, return NULL
- return(NULL)
- }
-
- Unit <- file.path(dir, paste("runit", name, "R", sep = "."))
- cat("# Test unit '", name, "'\n", sep = "", file = Unit)
-
- # Collect all tests from Objs together in the test unit
- # We provide the name of objects located in 'pos' environment
- for (objname in Objs) {
- if (regexpr("^test\\.", objname) > -1) testname <- objname else
- testname <- paste("test", objname, sep = ".")
- testname <- make.names(testname)
- cat('\n"', testname, '" <-\n', sep = "", file = Unit, append = TRUE)
- if (!exists(objname, where = pos)) {
- # Create a dummy test with DEACTIVATED entry
- body <- c(
- 'function() {',
- paste('\tDEACTIVATED("Object', objname, 'not found!")'),
- '}\n')
- } else {
- Test <- test(get(objname, pos = pos))
- if (is.null(Test)) {
- # Create a dummy test with DEACTIVATED entry
- body <- c(
- 'function() {',
- paste('\tDEACTIVATED("Object', objname, 'has no tests!")'),
- '}\n')
- } else {
- capture.body <-
- function(Data) {
- rval <- NULL
- File <- textConnection("rval", "w", local = TRUE)
- sink(File)
- on.exit({ sink(); close(File) })
- dput(Data, file = File, control = "useSource")
- on.exit()
- sink()
- close(File)
- return(rval)
- }
- body <- capture.body(Test)
- }
- }
- cat(body, sep = "\n", file = Unit, append = TRUE)
- }
- return(Unit)
-}
-
-runTest.svUnit <-
-function(x, name = make.names(deparse(substitute(x))), ...) {
- # Compile and run the test for this 'svUnit' object
- if (!is.svUnit(x))
- stop("'x' must be a 'svUnit' object")
- name <- as.character(name[1])
-
- # Decode tests contained in x
- tests <- as.character(x)
- dirs <- character()
- # Package suites...
- isPkg <- regexpr("^package:", tests) > -1
- if (any(isPkg)) {
- Pkgs <- tests[isPkg]
- Subdirs <- sub("^.+[(](.+)[)] *$", "\\1", Pkgs)
- Subdirs[Subdirs == Pkgs] <- ""
- Pkgs <- sub("^package:([^ ]+).*$", "\\1", Pkgs)
- for (i in 1:length(Pkgs)) {
- dir <- system.file(package = Pkgs[i], "unitTests", Subdirs[i])
- if (dir != "") dirs <- c(dirs, dir)
- }
- }
-
- # Add directories, and possibly make a temporary unit for test objects
- if (any(!isPkg)) {
- tests <- tests[!isPkg]
- # Directories
- isDir <- regexpr("^dir:", tests) > -1
- if (any(isDir))
- dirs <- c(dirs, sub("^dir:", "", tests[isDir]))
- # Objects
- if (any(!isDir)) {
- # make a temporary unit for the tests of these objects
- if (!is.null(Unit <- makeUnit(x, name = name))) {
- # Add this path to dirs, and make sure that the temporary file
- # is destroyed at the end
- dirs <- c(dirs, dirname(Unit))
- on.exit(unlink(Unit))
- }
- }
- }
-
- # Run these tests now
- res <- runUnit(name = name, dirs = dirs)
- return(invisible(res))
-}
Modified: pkg/svUnit/TODO
===================================================================
--- pkg/svUnit/TODO 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/TODO 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,31 +1,35 @@
= svUnit To Do list
-* Install SciViews-K Unit Komodo extension
+* guiTestFeedback() must be finished.
-* Mean to save and load vUnit objects; also automatically load concerned packages
+* Install SciViews-K Unit Komodo extension.
-* Output results in wiki format
+* Output results in htm, wiki, etc. format (summary.svSuiteData).
-* butler: benchmark and profiling => check it
+* Queue tests to run and run them asynchronously using tcltk and after() if
+this package is loaded and we are in interactive() mode.
-* Split example test into smaller test functions
+* RUnit code coverage functions.
-* Make a vignette (and perhaps a demo) for this package
+* People ask for checkWarning() function... But warnings are not part of code
+execution. Provide an example to show how, by using options(warning = ...) and
+checkException(), one can detect warnings.
-* Translate this package
+* butler: benchmark and profiling => check it.
-* In RUnit/share/R, there are checkCode.r and compareRUnitTestData.r. The former
- provides functions for test R code in R files, the latter does a comparison of
- timings in two test set runs, using a tolerance value. Worth checking and
- integrating later on!
+* Split example test into smaller test functions.
-* In RUnit: checkException() -> get silent argument value from
- getOption("RUnit.silent")
+* Make a vignette (and perhaps a demo) for this package.
-* In RUnit, make a CheckWarning() function
+* Translate this package.
+* In RUnit/share/R, there are checkCode.r and compareRUnitTestData.r. The former
+provides functions for test R code in R files, the latter does a comparison of
+timings in two test set runs, using a tolerance value. Worth checking and
+integrating later on!
+
* In RUnit: one bug is reported on RUnit SourceForge area for RUnit 0.4.17.
- Follow this to make sure it is corrected (or work on a patch!)
+Follow this to make sure it is corrected (or work on a patch!)
myfun <- function(a, b = 98, c = 99){
cat("a = ", a, ", b = ", b, ", c = ", c, "\n")
@@ -38,3 +42,6 @@
track$init()
inspect(myfun(1, c = 2), track = track)
# Here, we see that myfun is calld with argument not matched by names!
+
+* In svUnit checkTrue() is vectorized, but not in RUnit. I made a proposition to
+the RUnit maintainer => look what happens in future versions.
\ No newline at end of file
Added: pkg/svUnit/inst/komodo/sciviewskunit-ko.xpi
===================================================================
(Binary files differ)
Property changes on: pkg/svUnit/inst/komodo/sciviewskunit-ko.xpi
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Deleted: pkg/svUnit/inst/unitTests/VirtualClass/runit.VirtualClass.R
===================================================================
--- pkg/svUnit/inst/unitTests/VirtualClass/runit.VirtualClass.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/inst/unitTests/VirtualClass/runit.VirtualClass.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,118 +0,0 @@
-# runit.VirtualClass.R test suite
-# Just one example take from RUnit
-
-# --- Test setup ---
-
-if (FALSE) {
- # Not really needed, but can be handy when writing tests
- library("RUnit")
- library("testRUnit")
-}
-
-# package 'methods' is usually loaded, but make sure it is
-checkTrue(require(methods))
-
-# Define class (not exported yet by the program, and defined in .GlobalEnv!)
-className <- "MyVirtualBaseClass"
-setClass(className,
- representation("VIRTUAL",
- x = "numeric",
- y = "numeric",
- description = "character"),
- validity = NULL,
- sealed = FALSE,
- where = .GlobalEnv)
-
-if (!isGeneric("getX")) {
- setGeneric("getX", function(object, ...) standardGeneric("getX"),
- useAsDefault = TRUE, where = .GlobalEnv, valueClass = "numeric")
-}
-
-setMethod("getX", signature = className, function(object) return(object at x),
- where = .GlobalEnv)
-
-if (!isGeneric("setX<-")) {
- setGeneric("setX<-", function(object, value) standardGeneric("setX<-"),
- useAsDefault = TRUE, where = .GlobalEnv)
-}
-
-setMethod("setX<-", signature = signature(object = className, value = "numeric"),
- function(object, value) {
- if (length(value) < 1) {
- stop("value has to contain at least one element.")
- }
- if (any(is.na(value))) {
- stop("value may not contain NA(s).")
- }
- object at x <- value
- return(object)
- }, where = .GlobalEnv)
-
-
-# --- Test functions ---
-
-.setUp <- function() {
- # Executed before each test function
-}
-
-.tearDown <- function() {
- # Executed after each test function
-}
-
-test.createClass <- function() {
- setClass("A", contains = "numeric", where = .GlobalEnv)
- a <- new("A")
- checkTrue(validObject(a))
- removeClass("A", where = .GlobalEnv) # Better to use on.exit() here!
- checkException(new("A"))
-}
-
-testMyVirtualBaseClass.getX <- function() {
- testClassName <- "MyDerivedTestClass"
- setClass(testClassName,
- representation("MyVirtualBaseClass"),
- validity = NULL,
- sealed = FALSE,
- where = .GlobalEnv)
-
- on.exit(removeClass(testClassName, where = .GlobalEnv))
-
- # system constructor
- this <- new(testClassName)
-
- # constructor call succeeded?
- checkTrue(is(this, testClassName))
-
- ret <- getX(this)
- checkTrue(is(ret, "numeric"))
- # class default
- checkEquals(ret, numeric(0))
-}
-
-testMyVirtualBaseClass.setX <- function() {
- testClassName <- "MyDerivedTestClass"
- setClass(testClassName,
- representation("MyVirtualBaseClass"),
- validity = NULL,
- sealed = FALSE,
- where = .GlobalEnv)
-
- on.exit(removeClass(testClassName, where = .GlobalEnv))
-
- # system constructor
- this <- new(testClassName)
-
- # constructor call succeeded?
- checkTrue(is(this, testClassName))
-
- testSeq <- 1:23
- setX(this) <- testSeq
- ret <- getX(this)
- checkTrue(is(ret, "numeric"))
- checkEquals(ret, testSeq)
-
- # error handling
- checkException(setX(this) <- numeric(0))
- checkException(setX(this) <- as.numeric(NA))
- checkException(setX(this) <- c(1:4, NA))
-}
Added: pkg/svUnit/inst/unitTests/VirtualClass/runitVirtualClass.R
===================================================================
--- pkg/svUnit/inst/unitTests/VirtualClass/runitVirtualClass.R (rev 0)
+++ pkg/svUnit/inst/unitTests/VirtualClass/runitVirtualClass.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,118 @@
+# runit.VirtualClass.R test suite
+# Just one (little bit more complex) example taken from RUnit
+
+# --- Test setup ---
+if (FALSE) {
+ # Not really needed, but can be handy when writing tests
+ library("svUnit")
+}
+
+# package 'methods' is usually loaded, but make sure it is
+if (!require(methods)) stop("Package 'methods' is required!")
+
+# Define class (not exported yet by the program, and defined in .GlobalEnv!)
+className <- "MyVirtualBaseClass"
+setClass(className,
+ representation("VIRTUAL",
+ x = "numeric",
+ y = "numeric",
+ description = "character"),
+ validity = NULL,
+ sealed = FALSE,
+ where = .GlobalEnv)
+
+if (!isGeneric("getX")) {
+ setGeneric("getX", function(object, ...) standardGeneric("getX"),
+ useAsDefault = TRUE, where = .GlobalEnv, valueClass = "numeric")
+}
+
+setMethod("getX", signature = className, function(object) return(object at x),
+ where = .GlobalEnv)
+
+if (!isGeneric("setX<-")) {
+ setGeneric("setX<-", function(object, value) standardGeneric("setX<-"),
+ useAsDefault = TRUE, where = .GlobalEnv)
+}
+
+setMethod("setX<-", signature = signature(object = className, value = "numeric"),
+ function(object, value) {
+ if (length(value) < 1) {
+ stop("value has to contain at least one element.")
+ }
+ if (any(is.na(value))) {
+ stop("value may not contain NA(s).")
+ }
+ object at x <- value
+ return(object)
+ }, where = .GlobalEnv)
+
+
+# --- Test functions ---
+
+.setUp <- function() {
+ # Executed before each test function
+ # ...
+}
+
+.tearDown <- function() {
+ # Executed after each test function
+ # ...
+}
+
+testCreateClass <- function() {
+ setClass("A", contains = "numeric", where = .GlobalEnv)
+ a <- new("A")
+ checkTrue(validObject(a))
+ removeClass("A", where = .GlobalEnv) # Better to use on.exit() here!
+ checkException(new("A"))
+}
+
+testMyVirtualBaseClass.getX <- function() {
+ testClassName <- "MyDerivedTestClass"
+ setClass(testClassName,
+ representation("MyVirtualBaseClass"),
+ validity = NULL,
+ sealed = FALSE,
+ where = .GlobalEnv)
+
+ on.exit(removeClass(testClassName, where = .GlobalEnv))
+
+ # system constructor
+ this <- new(testClassName)
+
+ # constructor call succeeded?
+ checkTrue(is(this, testClassName))
+
+ ret <- getX(this)
+ checkTrue(is(ret, "numeric"))
+ # class default
+ checkEquals(numeric(0), ret)
+}
+
+testMyVirtualBaseClass.setX <- function() {
+ testClassName <- "MyDerivedTestClass"
+ setClass(testClassName,
+ representation("MyVirtualBaseClass"),
+ validity = NULL,
+ sealed = FALSE,
+ where = .GlobalEnv)
+
+ on.exit(removeClass(testClassName, where = .GlobalEnv))
+
+ # system constructor
+ this <- new(testClassName)
+
+ # constructor call succeeded?
+ checkTrue(is(this, testClassName))
+
+ testSeq <- 1:23
+ setX(this) <- testSeq
+ ret <- getX(this)
+ checkTrue(is(ret, "numeric"))
+ checkEquals(testSeq, ret)
+
+ # error handling
+ checkException(setX(this) <- numeric(0))
+ checkException(setX(this) <- as.numeric(NA))
+ checkException(setX(this) <- c(1:4, NA))
+}
Deleted: pkg/svUnit/inst/unitTests/runit.svTest.R
===================================================================
--- pkg/svUnit/inst/unitTests/runit.svTest.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/inst/unitTests/runit.svTest.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,82 +0,0 @@
-# runit.svTest.R test suite
-# by Ph. Grosjean <phgrosjean at sciviews.org>
-# run it simply by example(unitTests.svUnit)
-
-.setUp <- function () {
- # Executed before each test function
- # ... your code here
-}
-
-.tearDown <- function () {
- # Executed after each test function
- # ... your code here
-}
-
-test.svTest <- function () {
- # An R object
- mat <- matrix(rnorm(4), ncol = 2)
- # An example function
- foo <- function(x) return(x)
-
- checkTrue(!is.test(mat), "No associated test cases to 'mat'") #1
- checkTrue(!is.test(foo), "No associated test cases to 'foo'") #2
- checkTrue(is.null(test(foo)), "Return NULL if no test cases") #3
- checkTrue(!is.test(test(foo)), "No 'svTest' object if no test cases") #4
- checkTrue(!is.test(mat), "This is not a 'svTest' object (1)") #5
- checkTrue(!is.test(foo), "This is not a 'svTest' object (2)") #6
- checkTrue(!is.svTest(foo), "This is not a 'svTest' object (3)") #7
- checkTrue(!is.test("x"), "This is not a 'svTest' object (4)") #8
- checkTrue(!is.test(NULL), "This is not a 'svTest' object (5)") #9
- checkTrue(!is.test(NA), "This is not a 'svTest' object (6)") #10
-
- # Create very simple test cases for matrix 'mat' and function 'foo'
- test.mat <- svTest(function () {
- checkEqualsNumeric(nrow(mat), 2)
- checkTrue(is.numeric(mat))
- })
-
- test.foo <- function () {
- checkEqualsNumeric(foo(2), 2)
- checkException(foo("xx"))
- }
-
- checkTrue(is.test(svTest(test.foo)), "Creation of a 'svTest' object") #11
- checkTrue(is.test(as.svTest(test.foo)), "Coercion to a 'svTest' object") #12
- checkException(svTest(foo), "Functions with arguments not allowed") #13
- checkException(svTest("x"), "Strange argument to svTest") #14
-
- # Add test cases to an object
- test(mat) <- test.mat
-
- checkTrue(is.test(mat), "'mat' has associated test cases") #15
- checkIdentical(test(mat), test.mat, "test of 'mat' identical to 'test.mat'")#16
- checkTrue(is.test(test.mat), "Is this a 'svTest' object (1)?") #17
- checkTrue(is.svTest(test.mat), "Is this a 'svTest' object (2)?") #18
-
-
- # Use a function as test
- test(foo) <- test.foo
-
- checkTrue(has.test(foo), "'foo' has associated test cases") #19
- checkEquals(test(foo), svTest(test.foo), "test of 'foo' equals 'test.foo'") #20
- checkTrue(!is.test(test.foo), "Is this a 'svTest' object (3)?") #21
- checkTrue(is.svTest(test.foo), "Is this a 'svTest' object (4)?") #22
-
-
- # Transform into a svTest object and use it as test
- test.foo <- as.svTest(test.foo)
- test(foo) <- test.foo
-
- checkIdentical(test(test.foo), test.foo, "'test' returns a 'svTest' object") #23
- checkTrue(is.test(test.foo), "Is this a 'svTest' (5)?") #24
- checkTrue(is.test(foo), "'foo' has associated test cases") #25
- checkIdentical(test(foo), test.foo, "test of 'foo' identical to 'test.foo'")#26
-
- checkException(test(foo) <- "x", "Strange value to assign as 'test'") #27
- checkException(test(foo) <- function(y) y, "Try assign a function with arguments") #28
-
- # Strange,... but allowed
- test(test.foo) <- test.foo
-
- checkIdentical(test(test.foo), test.foo, "Assigning test to oneself") #29
-}
Deleted: pkg/svUnit/inst/unitTests/runit.svUnit.R
===================================================================
--- pkg/svUnit/inst/unitTests/runit.svUnit.R 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/inst/unitTests/runit.svUnit.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,51 +0,0 @@
-# runit.unitFunctions.R test suite
-# by Ph. Grosjean <phgrosjean at sciviews.org>
-# run it simply by example(unitTests.svUnit)
-
-.setUp <- function () {
- # Executed before each test function
- # ... your code here
-}
-
-.tearDown <- function () {
- # Executed after each test function
- # ... your code here
-}
-
-test.svUnit <- function () {
- checkTrue(is.svUnit(svUnitList()), "svUnitList() returns a 'svUnit' object")#1
- checkTrue("package:svUnit" %in% svUnitList(), "svUnitList() lists 'svUnit' package") #2
- checkTrue("package:svUnit (VirtualClass)" %in% svUnitList(), "svUnitList() lists 'VirtualClass' suite") #3
-
- # Create a 'svTest' object and another object containing a test in .GlobalEnv
- test.R <<- svTest(function () {
- checkTrue(1 < 2)
- })
-
- foo <- function(x) return(x)
- test(foo) <- function () {
- checkEqualsNumeric(foo(2), 2)
- checkException(foo("xx"))
- }
- Foo <<- foo # Place a copy of 'foo' in .GlobalEnv
-
- checkTrue("test.R" %in% svUnitList(), "svUnitList() lists 'svTest' objects") #4
- checkTrue("test(Foo)" %in% svUnitList(), "svUnitList() lists objects with tests") #5
- rm(foo)
- rm(test.R, Foo, pos = .GlobalEnv)
-}
-
-test.runTest <- function () {
- # A simple svTest object
- test.R <- svTest(function () {
- checkTrue(1 < 2)
- })
- checkTrue(inherits(runTest(test.R), "svUnitData"), "result of runTest(svTest) is svUnitData") #1
-
- ### TODO: more tests!
- rm(test.R)
-}
-
-test.unitErrorClear <- function() {
- ### TODO: tests for unitError() and unitClear()
-}
\ No newline at end of file
Added: pkg/svUnit/inst/unitTests/runitsvSuite.R
===================================================================
--- pkg/svUnit/inst/unitTests/runitsvSuite.R (rev 0)
+++ pkg/svUnit/inst/unitTests/runitsvSuite.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,64 @@
+# runitsvSuite.R test suite
+# by Ph. Grosjean <phgrosjean at sciviews.org>
+# run it simply by example(unitTests.svUnit)
+
+## Create a few objects we need for our tests
+
+# Save current exclusion list and clear it
+oex <- getOption("svUnit.excludeList")
+
+# Create a very simple 'svTest' object
+test_R <- svTest(function () {
+ checkTrue(1 < 2)
+})
+
+
+## The test cases
+
+.setUp <- function () {
+ # Executed before each test function
+ # Remove temporarily the exclusion list for our tests
+ options(svUnit.excludeList = NULL)
+
+ # Create an object with associated tests in .GlobalEnv
+ foo <- function(x) return(x)
+ test(foo) <- function () {
+ checkEqualsNumeric(2, foo(2), "foo(2) returns 2")
+ checkException(foo("x"), "foo(\"x\") raises an exception")
+ }
+ svSuite.foo <<- foo # Place a copy of 'foo' in .GlobalEnv
+
+ # Create an object without associated tests in .GlobalEnv
+ svSuite.bar <<- function(x) return(x^2)
+
+ # Create an integration test in .globalEnv
+ test_svSuite <<- svTest(function () {
+ checkTrue(1 == 1, "example test: 1 == 1")
+ checkException(nonexisting + 1, "exception when using non existing var")
+ })
+}
+
+.tearDown <- function () {
+ # Executed after each test function
+ # restore previous exclusion list
+ options(svUnit.excludeList = oex)
+ # Remove our object with tests in .GlobalEnv
+ rm(svSuite.foo, svSuite.bar, test_svSuite, envir = .GlobalEnv)
+}
+
+testsvSuite <- function () {
+ checkTrue(is.svSuite(svSuite("svSuite.foo")), "svSuite(\"svSuite.foo\") returns a 'svSuite' object")
+ checkTrue(is.svSuite(svSuite("svSuite.bar")), "svSuite(\"svSuite.bar\") returns a 'svSuite' object")
+ checkTrue(is.svSuite(svSuite("test_svSuite")), "svSuite(\"test_svSuite\") returns a 'svSuite' object")
+ checkTrue(is.svSuite(svSuite("nonexisting")), "svSuite(\"nonexisting\") returns a 'svSuite' object")
+ checkException(svSuite(nonexisting), "svSuite(nonexisting) raises an exception")
+}
+
+testsvSuiteList <- function () {
+ checkTrue(is.svSuite(svSuiteList()), "svSuiteList() returns a 'svSuite' object")
+ checkTrue("package:svUnit" %in% svSuiteList(), "svSuiteList() lists 'svSuite' package")
+ checkTrue("package:svUnit (VirtualClass)" %in% svSuiteList(), "svSuiteList() lists 'VirtualClass' suite")
+ checkTrue("test(svSuite.foo)" %in% svSuiteList(), "svSuiteList() lists objects with tests")
+ checkTrue("test_svSuite" %in% svSuiteList(), "svSuiteList() lists 'svTest' objects")
+ checkTrue("test_R" %in% svSuiteList(pos = parent.frame()), "svSuiteList() uses 'pos' correctly")
+}
Added: pkg/svUnit/inst/unitTests/runitsvTest.R
===================================================================
--- pkg/svUnit/inst/unitTests/runitsvTest.R (rev 0)
+++ pkg/svUnit/inst/unitTests/runitsvTest.R 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,96 @@
+# runitsvTest.R test suite
+# by Ph. Grosjean <phgrosjean at sciviews.org>
+# run it simply by example(unitTests.svUnit)
+
+## Create a few objects we need for tests
+
+# An R object (matrix)
+mat <- matrix(rnorm(4), ncol = 2)
+
+# Create very simple test cases for matrix 'mat'
+testmat <- svTest(function () {
+ checkEqualsNumeric(2, nrow(mat))
+ checkTrue(is.numeric(mat))
+})
+
+# An example function without test case
+foo <- function(x) return(x)
+
+# Another function with a test associated
+bar <- function(x) return(x^2)
+testbar <- svTest(function () {
+ checkEqualsNumeric(4, bar(2))
+ checkException(bar("xx"))
+})
+test(bar) <- testbar
+
+
+## The test cases
+
+.setUp <- function () {
+ # Executed before each test function
+ # ...
+}
+
+.tearDown <- function () {
+ # Executed after each test function
+ # ...
+}
+
+testis.test <- function () {
+ checkTrue(!is.test(foo), "No associated test cases to 'foo'")
+ checkTrue(is.test(testbar), "Is testbar a 'svTest'?")
+ checkTrue(is.test(bar), "Associated test cases to 'bar'")
+ checkTrue(!is.test(mat), "No associated test cases to 'mat'")
+ checkTrue(is.test(testmat), "Is an 'svTest' object a test?")
+
+ if (exists(".Log")) .Log$..Obj <- "test" # Switch the context to test()
+ checkTrue(is.test(test(foo)), "Return dummy test if no test cases")
+ checkIdentical(testbar, test(bar), "test of 'bar' identical to 'testbar'")
+
+ if (exists(".Log")) .Log$..Obj <- "test<-" # Switch the context to `test<-`()
+ checkException(test(foo) <- "x", "Strange value to assign as 'test'")
+ checkException(test(foo) <- function(y) y, "Try assign a function with arguments")
+ # Add test cases to an object
+ mat2 <- mat
+ checkTrue(is.test(test(mat2) <- testmat), "'mat2' valid test case association")
+ checkIdentical(testmat, test(mat2), "test of 'mat2' identical to 'testmat'")
+ # Strange,... but allowed
+ test(testbar) <- testbar
+ checkIdentical(testbar, test(testbar), "Assigning test cases to oneself")
+
+ if (exists(".Log")) .Log$..Obj <- "is.test" # Switch context back to is.test()
+ checkTrue(!is.test("x"), "'x' is is not a 'svTest' object")
+ checkTrue(!is.test(NULL), "NULL is not a 'svTest' object")
+ checkTrue(!is.test(NA), "NA is not a 'svTest' object")
+}
+
+testsvTest <- function () {
+ checkException(svTest(foo), "Functions with arguments not allowed")
+ checkException(svTest("x"), "Strange argument to svTest")
+ checkTrue(is.svTest(svTest(function() {})), "Creation of a minimal 'svTest' object")
+
+ if (exists(".Log")) .Log$..Obj <- "is.svTest" # Switch context to is.svTest()
+ checkTrue(is.svTest(testmat), "Is testmat a 'svTest' object?")
+ checkTrue(is.svTest(testbar), "Is testbar a 'svTest' object?")
+ checkTrue(is.svTest(test(bar)), "Is test(bar) a 'svTest' object?")
+ checkTrue(!is.svTest(foo), "'foo' is not a 'svTest' object")
+ checkTrue(!is.svTest("x"), "'x' is not a 'svTest' object")
+ checkTrue(!is.svTest(NULL), "NULL is not a 'svTest' object")
+ checkTrue(!is.svTest(NA), "NA is not a 'svTest' object")
+ checkTrue(!is.svTest(function () {}), "A function is not a 'svTest' object")
+
+ if (exists(".Log")) .Log$..Obj <- "as.svTest" # Switch context to as.svTest()
+ checkTrue(is.svTest(as.svTest(testmat)), "Coercion to a 'svTest' object")
+ checkException(as.svTest("x"), "Try coercion on wrong object")
+ checkException(as.svTest(function (y) y), "Try coercion on function with arguments")
+}
+
+testrunTest <- function () {
+ checkTrue(inherits(runTest(testbar), "svTestData"), "result of runTest(testbar) is 'svTestData'")
+ # Following tests fail currently for reasons I haven't spotted yet, but runTest() works wine
+ # outside of these tests... So, I deactivate them
+ DEACTIVATED("runTest(bar) does not work inside test functions")
+ checkTrue(inherits(runTest(test(bar)), "svTestData"), "result of runTest(test(bar)) is 'svTestData'")
+ checkTrue(inherits(runTest(bar), "svTestData"), "result of runTest(bar) is 'svTestData'")
+}
Added: pkg/svUnit/man/Log.Rd
===================================================================
--- pkg/svUnit/man/Log.Rd (rev 0)
+++ pkg/svUnit/man/Log.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,86 @@
+\name{Log}
+\alias{Log}
+\alias{createLog}
+\alias{clearLog}
+\alias{errorLog}
+\alias{lastTest}
+\alias{lastSuite}
+
+\title{ SciViews R log management functions }
+\description{
+ These functions define the code of test functions. They are designed to check
+ the result of some test calculation.
+}
+
+\usage{
+Log(description = NULL)
+createLog(description = NULL, deleteExisting = FALSE)
+clearLog()
+errorLog(stopit = TRUE, summarize = TRUE)
+lastTest()
+lastSuite()
+}
+
+\arguments{
+ \item{description}{ A (short) character string describing this test suite log }
+ \item{deleteExisting}{ Do we delete an existing a \code{.Log} object already
+ defined in \code{.GlobalEnv} (no, by default)? }
+ \item{stopit}{ Do we issue an error (\code{stop()} in case of any error or
+ failure? This is particularly useful if you want to interrupt R CMD check
+ on packages, when you included one or more test suites in examples (see
+ \code{?unitTests} }
+ \item{summarize}{ Should the summary of the log be printed in case we stop
+ execution of the code when an error is found (see \code{stopit} argument.
+ It is, indeed, useful to indicate at this time which tests failed or raised
+ an error. So, this argument should usually be left at its default value }
+}
+
+\value{
+ \code{Log()} and \code{createLog()} return the .Log object defined in
+ .GlobalEnv by reference (it is indeed an environment). So, you can use its
+ content (and change it, if you write functions to manipulate this log).
+
+ \code{clearLog()} return invisibly TRUE or FALSE, depending if an existing
+ log object was deleted or not.
+
+ \code{errorLog()} is mainly used for its side-effect of stopping code
+ execution and/or printing a summmary of the test runs in the context of
+ example massaging in R CMD check (see the \"Writing R extensions\" manual).
+ However, this function also returns invisibly a contingency table with the
+ number of successes, failures, errors and deactivated tests recorded so far.
+
+ \code{lastTest()} and \code{lastSuite()} recall results of last test and last
+ suite run, respectively.
+}
+
+\details{
+ svUnit records results of assertions (using the checkxxx() functions) in a
+ 'svSuiteData' object named \code{.Log} and located in .GlobalEnv. Hence, this
+ log is easy to access. However, in order to avoid errors in your code in case
+ this object was deleted, or not created, it is better to access it using
+ \code{Log()} which take care to create the object if it is missing.
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{svSuiteData}}, \code{\link{svSuite}}, \code{\link{svTest}},
+ \code{\link{check}} }
+
+\examples{
+clearLog() # Clear the svUnit log
+
+# Two correct tests
+(checkTrue(1 < 2))
+(checkException(log("a")))
+errorLog() # Nothing, because there is no error
+
+\dontrun{
+(checkTrue(1 > 2)) # This test fails
+lastTest() # Print results of last test
+errorLog() # Stop and summarize the tests run so far
+}
+
+clearLog()
+}
+
+\keyword{ utilities }
Added: pkg/svUnit/man/check.Rd
===================================================================
--- pkg/svUnit/man/check.Rd (rev 0)
+++ pkg/svUnit/man/check.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,116 @@
+\name{check}
+\alias{checkEquals}
+\alias{checkEqualsNumeric}
+\alias{checkIdentical}
+\alias{checkTrue}
+\alias{checkException}
+\alias{DEACTIVATED}
+
+\title{ SciViews R Unit check functions }
+\description{
+ These functions define the code of test functions. They are designed to check
+ the result of some test calculation.
+}
+
+\usage{
+checkEquals(target, current, msg = "", tolerance = .Machine$double.eps^0.5,
+ checkNames = TRUE, \dots)
+checkEqualsNumeric(target, current, msg = "",
+ tolerance = .Machine$double.eps^0.5, \dots)
+checkIdentical(target, current, msg = "")
+checkTrue(expr, msg = "")
+checkException(expr, msg = "", silent = getOption("svUnit.silentException"))
+DEACTIVATED(msg = "")
+}
+
+\arguments{
+ \item{current}{ An object created for comparison (not an S4 class object) }
+ \item{target}{ A target object as reference fo comparison }
+ \item{msg}{ An optional (short!) message to document a test. This message is
+ stored in the log and printed in front of each test report }
+ \item{tolerance}{ numeric >= 0. A numeric check does not fail if differences
+ are smaller than `tolerance' }
+ \item{checkNames}{ Flag, if \code{FALSE} the names attributes are set to
+ \code{NULL} for both \code{current} and \code{target} before performing
+ the check }
+ \item{expr}{ Syntactically valid R expression which can be evaluated and must
+ return a logical vector (\code{TRUE}|\code{FALSE}). A named expression is
+ also allowed but the name is disregarded. In \code{checkException()}, expr
+ is supposed to generate an error to pass the test }
+ \item{silent}{ Flag passed on to try, which determines if the error message
+ generated by the checked function is displayed at the R console. By default,
+ it is \code{FALSE} }
+ \item{\dots}{ Optional arguments passed to \code{all.equal()} or
+ \code{all.equal.numeric()} }
+}
+
+\value{
+ \code{TRUE} if the test succeeds, \code{FALSE} if it fails, possibly with a
+ 'result' attribute containing more information about the problem. This is
+ very different from corresponding functions in 'RUnit' that stop with an
+ error in case of test failure. Consequently, current functions do not require
+ the complex evaluation framework designed in 'RUnit' for that reason.
+}
+
+\details{
+ These check functions are equivalent to various methods of the class
+ junit.framework.Assert of Java junit framework. They should be code-compatible
+ with functions of same name in 'RUnit' 0.4.17, except for \code{checkTrue()}
+ that is vectorized here, but accept only a scalar result in 'RUnit'. For
+ scalar test, the behaviour of the function is the same in both packages.
+
+ See \code{svTest()} for examples of utilisation of these functions in actual
+ test cases attached to R objects.
+
+ See also the note about S4 objects in the \code{checkTrue()} online help of
+ the 'RUnit' package.
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> has adapted existing code
+ in 'RUnit' by Thomas Konig, Klaus Junemann & Matthias Burger and ported it
+ to 'svUnit' }
+
+\seealso{ \code{\link{svTest}}, \code{\link{Log}},
+ \code{\link{guiTestReport}}, \code{\link[RUnit]{checkTrue}} }
+
+\examples{
+library(datasets) # Make sure 'datasets' package is loaded
+clearLog() # Clear the svUnit log
+
+# All these tests are correct
+(checkEquals(c("A", "B", "C"), LETTERS[1:3]))
+(checkEqualsNumeric(1:10, seq(1, 10)))
+(checkIdentical(iris[1:50, ], iris[iris$Species == "setosa",]))
+(checkTrue(1 < 2))
+(checkException(log("a")))
+Log() # See what's recorded in the log
+
+# ... but these ones fail
+(checkEquals("A", LETTERS[1:3]))
+(checkEqualsNumeric(2:11, seq(1, 10)))
+(checkIdentical(iris[1:49, ], iris[iris$Species == "setosa",]))
+(checkTrue(1 > 2))
+(checkException(log(1)))
+Log() # See what's recorded in the log
+
+# Create a test function and run it
+foo <- function(x, y = 2) return(x * y)
+test(foo) <- function () {
+ #DEACTIVATED();
+ checkEqualsNumeric(5, foo(2))
+ checkEqualsNumeric(6, foo(2, 3))
+ checkTrue(is.test(foo))
+ checkTrue(is.test(test(foo)))
+ checkIdentical(test(foo), attr(foo, "test"))
+ checkException(foo("b"))
+ checkException(foo(2, "a"))
+}
+(runTest(foo))
+
+# Of course, everything is recorded in the log
+Log()
+
+clearLog()
+}
+
+\keyword{ utilities }
Added: pkg/svUnit/man/guiTestReport.Rd
===================================================================
--- pkg/svUnit/man/guiTestReport.Rd (rev 0)
+++ pkg/svUnit/man/guiTestReport.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,45 @@
+\name{guiTestReport}
+\alias{guiTestReport}
+\alias{guiTestFeedback}
+\alias{guiSuiteList}
+\alias{guiSuiteAutoList}
+
+\title{ Report or give feedback to the GUI client about running test units }
+\description{
+ These functions are usually not called from the command line. They return
+ data to compatible GUI clients, like Komodo Edit with the SciViews-K extension.
+}
+
+\usage{
+guiTestReport(object, sep = "\t", path = NULL, \dots)
+guiTestFeedback(object, path = NULL, \dots)
+guiSuiteList(sep = "\t", path = NULL, compare = TRUE)
+guiSuiteAutoList(\dots)
+}
+
+\arguments{
+ \item{object}{ A svUnitData object }
+ \item{\dots}{ Not used currently }
+ \item{sep}{ Field separator to use in the results }
+ \item{path}{ Path where to write a 'Suites.txt' file with the list of currently
+ available test suites (to be used by the GUI client). If \code{NULL}, no
+ file is written (by default) }
+ \item{compare}{ Do we compare the list of available test suite and return
+ something to the GUI client only if there are changes in the list? This is
+ used (when TRUE) to avoid unnecessary multiple processings of the same list
+ by the GUI client }
+}
+
+\value{
+ \code{guiSuiteList() returns thde list of available test suites invisibly.
+ \code{guiSuiteAutoList()} is used to establish a callback to automatically
+ list the available test suites in the GUI. It is not intended to be called
+ directly by the user. The other functions just return \code{TRUE} invisibly.
+ They are used for their side effect of sending data to compatible GUI clients. }
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{svTest}}, \code{\link{svSuite}}, \code{\link{koUnit_version}} }
+
+\keyword{ utilities }
Added: pkg/svUnit/man/koUnit.Rd
===================================================================
--- pkg/svUnit/man/koUnit.Rd (rev 0)
+++ pkg/svUnit/man/koUnit.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,79 @@
+\name{koUnit}
+\alias{koUnit_isAutoTest}
+\alias{koUnit_setAutoTest}
+\alias{koUnit_runTest}
+\alias{koUnit_showRUnitPane}
+\alias{koUnit_version}
+
+\title{ Interact with the test unit GUI in Komodo/SciViews-K }
+\description{
+ These functions allow controlling the test unit module (R Unit tab at right)
+ in Komodo with SciViews-K and SciViews-K Unit extensions
+ (see http://www.sciviews.org/SciViews-K). R must be correctly connected to
+ Komodo, meaning that the 'svGUI' package must be loaded with proper
+ configuration of client/server socket connections between R and Komodo. See
+ the manual about SciViews-K for more information. The functions defined here
+ are the same as JavaScript functions defined in the 'sv.r.unit' namespace in
+ Komodo/SciViews-K Unit. For instance, \code{koUnit_runTest()} is equivalent
+ to \code{sv.r.unit.runTest();} in a Javascript macro in Komodo.
+}
+
+\usage{
+koUnit_isAutoTest()
+koUnit_setAutoTest(state)
+koUnit_runTest()
+koUnit_showRUnitPane(state)
+koUnit_version()
+}
+
+\arguments{
+ \item{state}{ \code{TRUE} or \code{FALSE}, or missing for
+ \code{koUnit_showRUnitPane()}, in this case, the R Unit pane visibility is
+ toggled }
+}
+
+\value{
+ \code{koUnit_isAutoTest()} returns \code{TRUE} if the test unit is in auto
+ mode in Komodo (the selected tests are run automatically each time a .R file
+ edited in Komodo is saved).
+
+ \code{koUnit_version()} returns the version for which the SciViews-K Unit
+ extension was designed for. This allow to check if this version is compatible
+ with current 'svUnit' R package version, and to propose to update the Komodo
+ extension if needed (this mechanism is not running currently, but it will be
+ implemented in the future to avoid or limit incompatibilities between
+ respective R and Komodo extensions).
+
+ The other functions are invoked for their side effect and they return nothing.
+ Note, however, that correct execution of this code in Komodo is verified, and
+ the functions issue an error in R if they fail to execute correctly in Komodo.
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{guiTestReport}} }
+
+\examples{
+\dontrun{
+# Make sure R is communicating with Komodo before use, see ?koCmd in svGUI
+koUnit_version()
+
+# Toggle visibility of the R Unit pane in Komodo twice
+koUnit_showRUnitPane()
+koUnit_showRUnitPane()
+
+# Make sure that the R Unit pane is visible
+koUnit_showRUnitPane(TRUE)
+
+# Is the test unit running in auto mode?
+koUnit_isAutoTest()
+
+# Toggle auto test mode off
+koUnit_setAutoTest(FALSE)
+
+# Run the test units from within Komodo
+koUnit_runTest()
+}
+}
+
+\keyword{ utilities }
Deleted: pkg/svUnit/man/runUnit.Rd
===================================================================
--- pkg/svUnit/man/runUnit.Rd 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/man/runUnit.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,75 +0,0 @@
-\name{runUnit}
-\alias{runUnit}
-\alias{unitClear}
-\alias{unitError}
-\alias{print.svUnitData}
-\alias{summary.svUnitData}
-
-\title{ Compile and run a complete test unit }
-\description{
- Compile a test unit and run it silently. Increment counters for errors,
- failings, and deactivated items. Manage the errors and warnings in a
- different depending if we run in interactive mode, or not (R CMD check). In
- this last case, make sure to break checking of package in case of errors or
- failings, but not otherwise.
-}
-
-\usage{
-runUnit(name, dirs, print.errors = !interactive(), warn = print.errors,
- rngKind = "Marsaglia-Multicarry", rngNormalKind = "Kinderman-Ramage")
-
-unitClear()
-unitError(errors = TRUE, failures = TRUE, deactivated = TRUE, stopit = TRUE)
-
-\method{print}{svUnitData}(x, \dots)
-\method{summary}{svUnitData}(object, \dots)
-}
-
-\arguments{
- \item{name}{ The name of the test suite to build and run }
- \item{dirs}{ The directories where to look for \code{runit*.R} test files.
- These test files must be sourceable and must contain one or more
- \code{test.*()} functions implementing the different tests }
- \item{print.errors}{ Do we print explicit messages for each error of failing? }
- \item{warn}{ Do we issue a warning if there are deactivated items? }
- \item{rngKind}{ Name of a valid RNG version (see \code{RNGkind}) }
- \item{rngNormalKind}{ Name of a valid rnorm RNG version (see \code{RNGkind}) }
- \item{errors}{ If \code{TRUE}, check if there where errors in any test of all
- test suites run since last \code{unitClear()} }
- \item{failures}{ If \code{TRUE}, check if there where failures in any test of
- all test suites run since last \code{unitClear()} }
- \item{deactivated}{ If \code{TRUE}, check if there where deactivated tests in
- any test suites run since last \code{unitClear()} }
- \item{stopit}{ Do we stop execution of the code in case of any detected error
- or failure? }
- \item{x}{ A 'svUnitData' object to print }
- \item{object}{ A 'svUnitData' object to summarize }
- \item{\dots}{ Not used for\code{summary()} }
-}
-
-\value{
- \code{unitRun()} returns an object of class 'svUnitData', similar to
- 'RUnitTestData' in the RUnit package with all results from the tests run.
-
- \code{unitClear()} returns a list with the number of errors (nErr) and the
- number of deactivated tests (nDeactivated) and the number of failures (nFail)
- invisibly. The function is called for its side effect of clearing these counters.
-
- \code{unitError()} returns \code{TRUE} if there are any errors and/or failures
- recorded in the global counters. This function is useful for integrating your
- test units with the "R CMD check" mechanism of checking R packages (see the
- manual "Writing R extensions"). Just create an example that run all the test
- suites you want to integrate, and then, finish your example with
- \code{unitError()}. See \code{?unitTests.svUnit} for an example.
-}
-
-\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
-
-\seealso{ \code{\link{svTest}}, \code{\link{svUnit}},
- \code{\link[RUnit]{defineTestSuite}} }
-
-\examples{
-### TODO...
-}
-
-\keyword{ utilities }
Added: pkg/svUnit/man/svSuite.Rd
===================================================================
--- pkg/svUnit/man/svSuite.Rd (rev 0)
+++ pkg/svUnit/man/svSuite.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,204 @@
+\name{svSuite}
+\alias{svSuite}
+\alias{as.svSuite}
+\alias{is.svSuite}
+\alias{svSuiteList}
+\alias{print.svSuite}
+\alias{makeUnit.svSuite}
+\alias{runTest.svSuite}
+
+\title{ Create and run test suites by collecting together unit tests and
+ function tests defined in objects }
+\description{
+ A 'svSuite' object is essentially a list of test units directories (or
+ packages, in this case, corresponding directories are PKG/unitTests and its
+ subdirectories), and of object names containing tests to add temporarily to
+ the test suite. These must be formatted in a concise way as described for the
+ 'tests' argument.
+
+ \code{svSuiteList()} lists all loaded packages having /unitTests/runit*.R
+ files (or similar files in subdirectories), and all objects in the user
+ workspace that have a 'test' attribute, or are 'svTest' objects (by default).
+ It is a rather exhaustive list of all test items currently available in the
+ current R session, but restricted by \code{getOption("svUnit.excludeList")}.
+
+ \code{makeUnit()} writes a test unit on disk with the tests from the objects
+ lised in the 'svSuite' object that do not belong yet to a test unit.
+ \code{runTest()} runs all the test in packages, directories and objects listed
+ in the 'svSuite' object.
+}
+
+\usage{
+svSuite(tests)
+
+as.svSuite(x)
+is.svSuite(x)
+
+svSuiteList(packages = TRUE, objects = TRUE, dirs = getOption("svUnit.dirs"),
+ excludeList = getOption("svUnit.excludeList"), pos = .GlobalEnv,
+ loadPackages = FALSE)
+
+\method{print}{svSuite}(x, \dots)
+\method{makeUnit}{svSuite}(x, name = make.names(deparse(substitute(x))),
+ dir = tempdir(), objfile = "", codeSetUp = NULL, codeTearDown = NULL,
+ pos = .GlobalEnv, \dots)
+\method{runTest}{svSuite}(x, name = make.names(deparse(substitute(x))), \dots)
+}
+
+\arguments{
+ \item{tests}{ A character string with items to include in the test suite.
+ It could be 'package:PKG' for including test units located in the /unitTests
+ subdirectory of the package PGK, or 'package:PKG (SUITE)' for test units
+ located in the subdirectory /unitTests/SUITE of package PKG, or 'dir:MYDIR'
+ for including test units in MYDIR, or 'test(OBJ)' for tests embedded in an
+ object, or 'OBJ' for 'svTest' object directly }
+ \item{x}{ Any kind of object }
+ \item{packages}{ Do we list test units available in loaded packages?
+ Alternatively one can provide a character vector of package names, and it
+ will be used to filter packages (take care: in this case it will look at
+ installed packages, not only loaded packages!) }
+ \item{objects}{ Do we list test available in objects? Alternatively, one can
+ provide a character vector of object names, and it will filter objects in
+ 'pos' according to this vector }
+ \item{dirs}{ An additional list of directories where to look for more test
+ units. For convenience, this list can simply be saved as an 'svUnit.dirs'
+ options }
+ \item{excludeList}{ A list of items to exclude from the listing. The function
+ uses regular expression to match the exclusions. So, for instance, specifying
+ \code{"package:MYPKG"} will exclude all items from package 'MYPKG', while
+ using \code{"package:MYPKG$"} will exclude only tests suites defined in the
+ .../MYPKG/unitTests directory, bur not in its subdirectories. For
+ convenience, it can be saved in a 'svUnit.excludeList' option. By default,
+ all tests for packages whose name start with 'sv' or 'RUnit' are excluded,
+ that is, \code{c("package:sv", "package:RUnit")} }
+ \item{pos}{ The environment to look for 'objects' (environment, character
+ string with name of an environment, or interger with position of the
+ environment in the search path }
+ \item{loadPackages}{ In the case a list of packages is provided in
+ \code{packages =}, do we make sure that these packages are loaded? If yes,
+ the function will try to load all packages in that list that are not loaded
+ yet and will issue a warning for the packages not found. Default,
+ \code{FALSE} }
+ \item{name}{ The name of the test suite to build }
+ \item{dir}{ The directory where to create the test unit file }
+ \item{objfile}{ The path to the file containing the original source code of
+ the object being tested. This argument is used to bring a context for a
+ test and allow a GUI to automatically open the source file for edition when
+ the user clicks on a test that failed or raised an error }
+ \item{codeSetUp}{ An expression with some code you want to add to the
+ \code{.setUp() } function in your unit file (this function is executed
+ before each test }
+ \item{codeTearDown}{ An expression with some code you want to add to the
+ \code{.tearDown() } function in your unit file (this function is executed
+ after each test }
+ \item{\dots}{ Further arguments to pass to \code{makeUnit()} or
+ \code{runTest()} (not used yet) }
+}
+
+\value{
+ \code{svSuite()}, \code{as.svSuite()} and \code{svSuiteList} return a
+ 'svSuite' object. \code{is.svSuite()} returns \code{TRUE} if the object is an
+ 'svSuite'.
+
+ \code{makeUnit()} creates a test unit file on disk, and \code{runTest()} run
+ the tests in such a file. They are used for their side-effect, but the first
+ one also returns the file created, and the second one returns invisibly the
+ list of all test unit files that where sourced ans run.
+}
+
+\details{
+ Thanks to the variety of sources allowed for tests, it is possible to define
+ these tests in a structured way, inside packages, like for the 'RUnit'
+ package (but with automatic recognition of test units associated to packages,
+ in the present case). It is also easy to define tests more loosely by just
+ attaching those tests to the objects you want to check. Whenever there objects
+ are loaded in the user's workspace, their tests are available. In both cases,
+ a test unit file on disk is sourced in a local environment and test functions
+ are run (same approach as in the 'RUnit' package, and the same test unit files
+ should be compatibles with both 'RUnit' and 'svUnit' packages), but in the
+ case of a loosy definition of the tests by attachment to objects, the test
+ unit file is created on the fly in the temporary directory (by default).
+
+ At any time, you can transform a series of tests loosy attached to objects
+ into a test unit file by applying \code{makeUnit()} to a 'svSuite' object,
+ probably specifying another directory than the (default) temporary dir for
+ more permanent storage of your test unit file. The best choice is the
+ '/inst/unitTests' directory of a package source, or one of its subdirectories.
+ That way, your test unit file(s) will be automatically listed and available
+ each time you load the compiled package in R (if you list them using
+ \code{svSuiteList()}). Of course, you still can exclude tests from given
+ packages by adding 'package:PKG' in the exclusion list with something like:
+ \code{options(svUnit.excludeList = c(getOption("svUnit.excludeList"), "package:PKG"))}.
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{svSuiteData}}, \code{\link{svTest}}, \code{\link{Log}},
+ \code{\link{check}}, \code{\link[RUnit]{checkTrue}} }
+
+\examples{
+svSuiteList() # List all currently available test units and test cases
+# Exclusion list is used (regular expression filtering!). It contains:
+(oex <- getOption("svUnit.excludeList"))
+# clear it, and relist available test units
+options(svUnit.excludeList = NULL)
+svSuiteList()
+
+# Two functions that include their test cases
+Square <- function(x) return(x^2)
+test(Square) <- function() {
+ checkEquals(9, Square(3))
+ checkEquals(c(1, 4, 9), Square(1:3))
+ checkException(Square("xx"))
+}
+
+Cube <- function(x) return(x^3)
+test(Cube) <- function() {
+ checkEquals(27, Cube(3))
+ checkEquals(c(1, 8, 28), Cube(1:3))
+ checkException(Cube("xx"))
+}
+
+# A separate test case object (not attached to a particular object)
+# This is the simplest way to loosely define quick and durty integration tests
+test_Integrate <- svTest(function() {
+ checkTrue(1 < 2, "check1")
+ v <- 1:3 # The reference
+ w <- 1:3 # The value to compare to the reference
+ checkEquals(v, w)
+})
+
+# A function without test cases (will be filtered out of the suite list)
+foo <- function(x) return(x)
+
+# Look now what tests are available
+svSuiteList()
+
+# Only objects, no package units
+svSuiteList(packages = FALSE)
+
+\dontrun{
+# Create the test unit file for all objects with tests in .GlobalEnv
+myunit <- makeUnit(svSuiteList(), name = "AllTests")
+file.show(myunit, delete.file = TRUE)
+}
+
+# Filter objects using a list (object with/without tests and a nonexisting obj)
+svSuiteList(packages = FALSE, objects = c("Cube", "foo", "bar"))
+
+# Create another svSuite object with selected test items
+(mysuite <- svSuite(c("package:svUnit (VirtualClass)", "test(Cube)")))
+is.svSuite(mysuite) # Should be!
+
+\dontrun{
+# Run all the tests currently available
+(runTest(svSuiteList(), name = "AllTests"))
+summary(Log())
+}
+
+# Restore previous exclusion list, and clean up the environment
+options(svUnit.excludeList = oex)
+rm(Square, Cube, foo, test_Integrate, mysuite, myunit, oex)
+}
+
+\keyword{ utilities }
Added: pkg/svUnit/man/svSuiteData.Rd
===================================================================
--- pkg/svUnit/man/svSuiteData.Rd (rev 0)
+++ pkg/svUnit/man/svSuiteData.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,148 @@
+\name{svSuiteData}
+\alias{svSuiteData}
+\alias{is.svSuiteData}
+\alias{stats.svSuiteData}
+\alias{metadata}
+\alias{metadata.svSuiteData}
+\alias{print.svSuiteData}
+\alias{summary.svSuiteData}
+\alias{protocol}
+\alias{protocol.default}
+\alias{protocol.svSuiteData}
+\alias{protocol_text}
+\alias{protocol_text.svSuiteData}
+
+\title{ Objects of class 'svSuiteData' contain results from running test suites }
+\description{
+ The 'svSuiteData' object contains results of all test run in one or more test
+ suites. The \code{checkxxx()} functions and the \code{runTest()} method
+ generate data (objects 'svTestData') contained in the default 'svSuiteData'
+ named \code{.Log} and located in .GlobalEnv. It is then possible to display
+ and report information it contains in various ways to analyze the results.
+}
+
+\usage{
+is.svSuiteData(x)
+
+\method{stats}{svSuiteData}(object, \dots)
+
+metadata(object, \dots)
+\method{metadata}{svSuiteData}(object, fields = c("R.version", "sessionInfo",
+ "time", "description"), \dots)
+
+\method{print}{svSuiteData}(x, all = FALSE, file = "", append = FALSE, \dots)
+
+\method{summary}{svSuiteData}(object, ...)
+
+protocol(object, type = "text", file = "", append = FALSE, \dots)
+\method{protocol}{default}(object, type = "text", file = "", append = FALSE, \dots)
+\method{protocol}{svSuiteData}(object, type = "text", file = "", append = FALSE, \dots)
+protocol_text(object, file = "", append = FALSE, \dots)
+\method{protocol_text}{svSuiteData}(object, file = "", append = FALSE, ...)
+}
+
+\arguments{
+ \item{x}{ Any kind of object, or a 'svSuiteData' object in the case of
+ \code{print}. }
+ \item{object}{ a 'svSuiteData' object }
+ \item{fields}{ Character vector. The name of all metadata items you want to
+ extract for the object. The default value is an exhaustive list of all
+ available metadata (i.e., defined by default) in the object, but you
+ can add more: just add a corresponding attribute to your object. }
+ \item{all}{ Do we print concise report for all test, or only for the tests
+ that fail or produce an error? }
+ \item{file}{ Character. The path to the file where to write the report. If
+ \code{file = ""}, the protocol report is output to the console }
+ \item{append}{ Do we append to this file? }
+ \item{type}{ Character. The type of protocol report to create. For the moment,
+ only \code{type = "text"} is supported, but further types (HTML, LaTeX,
+ Wiki, etc.) will be provided later }
+ \item{\dots}{ Further arguments to pass to methods. Not used yet. }
+}
+
+\value{
+ \code{is.svSuiteData()} returns \code{TRUE} if the object is an 'svSuiteData'.
+ The various methods serve to extract or print content in the object.
+}
+
+\details{
+ A 'svSuiteData' is, indeed, an environment. The results for the various tests
+ runs are in non hidden (i.e., names not starting with a dot) objects that are
+ of class 'svTestData' in this environment. Various other objects that control
+ the execution of the test, their context, etc. are contained as hidden objects
+ with name starting with a dot. Note that using an environment instead of a
+ list for this object allows for a call by reference instead of a usual call by
+ value in R, when passing this object to a function. This property is largely
+ exploited in all svUnit functions to make sure results of test runs are
+ centralized in the same log ('svSuiteData' object).
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{svSuite}}, \code{\link{is.svTestData}}, \code{\link{check}},
+ \code{\link{Log}} }
+
+\examples{
+clearLog() # Clear any existing log
+
+# Run some tests
+checkTrue(1 < 2)
+checkException(log("a"))
+foo <- function(x, y = 2) return(x * y)
+test(foo) <- function () {
+ checkEqualsNumeric(4, foo(2))
+ checkEqualsNumeric(6, foo(2, nonexisting))
+ checkTrue(is.test(foo))
+ warning("This is a warning")
+ cat("Youhou from test!\n") # Don't use, except for debugging!
+ checkTrue(is.test(test(foo)))
+ checkIdentical(attr(foo, "test"), test(foo))
+ checkException(foo(2, nonexisting))
+ #DEACTIVATED("My deactivation message")
+ checkException(foo(2)) # This test fails
+}
+runTest(foo)
+
+# Now inspect the log, which is a 'svSuiteData' object
+is.svSuiteData(Log())
+stats(Log())
+metadata(Log())
+Log() # Print method
+summary(Log())
+
+# To get a print of the test protocol on file, use:
+protocol(Log(), type = "text", file = "RprofProtocol.out")
+file.show("RprofProtocol.out")
+unlink("RprofProtocol.out")
+
+rm(foo)
+
+\dontrun{
+# Profiling of very simple test runs
+library(utils)
+createLog(description = "test profiling", deleteExisting = TRUE)
+imax <- 3
+jmax <- 100
+l <- 50
+Rprof()
+for (i in 1:imax) {
+ # Change the context for these tests
+ .Log$..Test <- paste("Test", i, sep = "")
+ .Log$..Tag <- paste("#", i, sep = "")
+ res <- system.time({
+ for (j in 1:jmax) checkTrue(i <= j, "My test")
+ }, gcFirst = TRUE)[3]
+ print(res)
+ flush.console()
+}
+Rprof(NULL)
+# Look at profile
+summaryRprof()
+unlink("Rprof.out")
+
+# Look at the log
+summary(Log())
+}
+}
+
+\keyword{ utilities }
Modified: pkg/svUnit/man/svTest.Rd
===================================================================
--- pkg/svUnit/man/svTest.Rd 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/man/svTest.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -5,6 +5,7 @@
\alias{test}
\alias{test<-}
\alias{is.test}
+\alias{print.svTest}
\alias{makeUnit}
\alias{makeUnit.default}
\alias{makeUnit.svTest}
@@ -15,9 +16,10 @@
\title{ Create, attach to and manipulate test functions in R objects }
\description{
Test functions are functions without arguments with class 'svTest' containing
- one or more assertions using \code{checkXXX()} functions from RUnit (see
- examples). They can be attached to any object as a 'test' attribute, written
- to unit files or run.
+ one or more assertions using \code{checkxxx()} functions. They can
+ be attached to any object as a 'test' attribute. They can also be transferred
+ into a more formal test unit file on disk by applying the \code{makeUnit()}
+ method.
}
\usage{
@@ -29,26 +31,48 @@
test(x) <- value
is.test(x)
+\method{print}{svTest}(x, \dots)
+
makeUnit(x, \dots)
\method{makeUnit}{default}(x, name = make.names(deparse(substitute(x))),
- dir = tempdir(), \dots)
+ dir = tempdir(), objfile = "", codeSetUp = NULL, codeTearDown = NULL, \dots)
\method{makeUnit}{svTest}(x, name = make.names(deparse(substitute(x))),
- dir = tempdir(), \dots)
+ dir = tempdir(), objfile = "", codeSetUp = NULL, codeTearDown = NULL, \dots)
runTest(x, \dots)
-\method{runTest}{default}(x, name = make.names(deparse(substitute(x))), \dots)
-\method{runTest}{svTest}(x, name = make.names(deparse(substitute(x))), \dots)
+\method{runTest}{default}(x, name = deparse(substitute(x)), objfile = "",
+ tag = "", msg = "", \dots)
+\method{runTest}{svTest}(x, name = deparse(substitute(x)), objfile = "",
+ tag = "", msg = "", \dots)
}
\arguments{
- \item{testFun}{ A function without arguments defining assertions for tests to
- be transformed into a 'svTest' object }
+ \item{testFun}{ A function without arguments defining assertions (using
+ checkxxx() functions) for tests to be transformed into a 'svTest' object }
\item{x}{ Any kind of object }
- \item{value}{ The tests to place in the object (as 'test' attribute).
- Could be a 'svTest' object, or a function without arguments with assertions
- (\code{checkXXX()} functions) }
- \item{name}{ The name of a test unit }
- \item{dir}{ The directory where to create a test unit }
+ \item{value}{ The tests to place in the object (as 'test' attribute);
+ could be a 'svTest' object, or a function without arguments with assertions
+ (\code{checkxxx()} functions) }
+ \item{name}{ The name of a test }
+ \item{dir}{ The directory where to create the test unit file }
+ \item{objfile}{ The path to the file containing the original source code of
+ the object being tested. This argument is used to bring a context for a
+ test and allow a GUI to automatically open the source file for edition when
+ the user clicks on a test that failed or raised an error }
+ \item{codeSetUp}{ An expression with some code you want to add to the
+ \code{.setUp() } function in your unit file (this function is executed
+ before each test }
+ \item{codeTearDown}{ An expression with some code you want to add to the
+ \code{.tearDown() } function in your unit file (this function is executed
+ after each test }
+ \item{tag}{ A tag is a character string identifying a location in source code
+ files (either a test unit file, or the original source code of the tested
+ objects defined in \code{objfile}. This character string will be searched
+ by the text editor for easy location of the cursor near the corresponding`
+ test command, or near the location in the original object that is concerned
+ by this test. Use any string you want to uniquely identify your tag, both
+ in your files, and in this argument }
+ \item{msg}{ A message you want to associate with this test run }
\item{\dots}{ Further arguments to the method (not used yet) }
}
@@ -60,28 +84,30 @@
if it finds something there.
\code{makeUnit()} takes an object, extract its test function and write it in
- a sourceable test unit on the disk. RUnit functions need such files.
+ a sourceable test unit on the disk (it should be compatible with 'RUnit' test
+ unit files too).
- \code{runTest()} returns a 'svUnitData' object identical (for the moment) to
- the 'RUnitTestData' objects returned by \code{runTestSuite()} in package
- RUnit.
+ \code{runTest()} returns invisibly a 'svTestData' object with all results
+ after running specified tests.
}
\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
-\seealso{ \code{\link{svUnit}}, \code{\link{runUnit}},
- \code{\link[RUnit]{checkTrue}}, \code{\link[RUnit]{runTestSuite}} }
+\seealso{ \code{\link{svSuite}}, \code{\link{is.svTestData}},
+ \code{\link{check}}, \code{\link{Log}} }
\examples{
+clearLog() # Clear the log file
+
foo <- function(x, y = 2) return(x * y)
is.test(foo) # No
# Create test cases for this function
test(foo) <- function () {
- checkEqualsNumeric(foo(2), 4)
- checkEqualsNumeric(foo(2, 3), 6)
+ checkEqualsNumeric(4, foo(2))
+ checkEqualsNumeric(6, foo(2, 3))
checkTrue(is.test(foo))
checkTrue(is.test(test(foo)))
- checkIdentical(test(foo), attr(foo, "test"))
+ checkIdentical(attr(foo, "test"), test(foo))
checkException(foo(2, "aa"))
checkException(foo("bb"))
}
@@ -99,12 +125,19 @@
bar <- test(foo)
(runTest(bar))
+# How fast can we run 100 times such kind of tests (700 test in total)?
+# (just an indication because in real situation with test unit files, we
+# have also the time required to source the units!)
+system.time(for (i in 1:100) runTest(foo))[3]
+
is.svTest(test(foo)) # Yes, of course!
# When an object without associated test is passed to runTest(), a simple
# test containing only a DEACTIVATED entry is build
x <- 1:10
summary(runTest(x))
+summary(Log())
+
rm(foo, bar, x)
}
Added: pkg/svUnit/man/svTestData.Rd
===================================================================
--- pkg/svUnit/man/svTestData.Rd (rev 0)
+++ pkg/svUnit/man/svTestData.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,70 @@
+\name{svTestData}
+\alias{is.svTestData}
+\alias{stats}
+\alias{stats.svTestData}
+\alias{print.svTestData}
+\alias{summary.svTestData}
+
+\title{ Objects of class 'svTestData' contain results from running a test }
+\description{
+ The 'svTestData' contains results of test run. The \code{checkxxx()} functions
+ and the \code{runTest()} method generate one such object which is located in
+ the \code{.Log} object in .GlobalEnv. It is then possible to display and
+ report information it contains in various ways to analyze the results.
+}
+
+\usage{
+is.svTestData(x)
+
+stats(object, \dots)
+\method{stats}{svTestData}(object, \dots)
+
+\method{print}{svTestData}(x, all = FALSE, header = TRUE, file = "",
+ append = FALSE, \dots)
+\method{summary}{svTestData}(object, header = TRUE, file = "",
+ append = FALSE, \dots)
+}
+
+\arguments{
+ \item{x}{ Any kind of object, or a 'svTestData' object in the case of
+ \code{print}. }
+ \item{object}{ a 'svTestData' object }
+ \item{all}{ Do we print concise report for all test, or only for the tests
+ that fail or produce an error? }
+ \item{header}{ Do we print a header or not? }
+ \item{file}{ Character. The path to the file where to write the report. If
+ \code{file = ""}, the report is output to the console }
+ \item{append}{ Do we append to this file? }
+ \item{\dots}{ Further arguments to pass to methods. Not used yet. }
+}
+
+\value{
+ \code{is.svTestData()} returns \code{TRUE} if the object is an 'svTestData'.
+ The various methods serve to extract or print content in the object.
+}
+
+\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
+
+\seealso{ \code{\link{svTest}}, \code{\link{svSuiteData}}, \code{\link{check}},
+ \code{\link{Log}} }
+
+\examples{
+foo <- function(x, y = 2) return(x * y)
+is.test(foo) # No
+# Create test cases for this function
+test(foo) <- function () {
+ checkEqualsNumeric(4, foo(2))
+ checkEqualsNumeric(5, foo(2, 3))
+ checkEqualsNumeric(5, foo(nonexists))
+}
+# Generate a 'svTestData' object by running the test
+obj <- runTest(foo) # Equivalent to runTest(test(foo)), but shorter
+obj
+summary(obj)
+stats(obj)
+is.svTestData(obj)
+
+rm(foo, obj)
+}
+
+\keyword{ utilities }
Added: pkg/svUnit/man/svUnit-package.Rd
===================================================================
--- pkg/svUnit/man/svUnit-package.Rd (rev 0)
+++ pkg/svUnit/man/svUnit-package.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -0,0 +1,149 @@
+\name{svUnit-package}
+\alias{svUnit-package}
+\alias{svUnit}
+\docType{package}
+\title{
+A framework for test cases, test units and test suites in R
+}
+\description{
+The SciViews svUnit package defines a framework for testing R code, not unlike
+jUnit for Java. It is inspired on the \code{checkxxx()} functions from the RUnit
+package and the same test unit files should be compatible with both svUnit and
+RUnit.
+}
+\details{
+\tabular{ll}{
+Package: \tab svUnit\cr
+Type: \tab Package\cr
+Version: \tab 0.6-0\cr
+Date: \tab 2008-06-22\cr
+License: \tab GPL 2 or above, at your convenience\cr
+}
+The test unit framework provided in svUnit is based on tests, also called
+assertions, implemented in \code{checkxxx()} functions. For instance, the
+\code{checkTrue(expr)} function check if its 'expr' argument returns \code{TRUE}.
+Results of these assertions are collected in a centralized logger located in
+the \code{.Log} object in .GlobalEnv. This is a 'svSuiteData' object with data
+about the context of the tests (see for instance, \code{lastTest()},
+\code{lastSuite()} or \code{metadata(.Log)}).
+
+Assertions can give three results: (1) \code{TRUE} if success, (2) \code{FALSE}
+in case of failure (in our example, 'expr' in \code{checkTrue(expr)} did not
+return \code{TRUE}), and (3) \code{NA} if the code in 'expr' cannot be parsed or
+executed correctly. All these errors or failures are catch and recorded in the
+logger, as individual 'svTestData' objects.
+
+Both the logger ('svSuiteData' object) and test records inside it ('svTestData'
+objects) have convenient methods to visualize information they contain:
+\code{print()}, \code{summary()} and \code{stats()} methods. Access to the
+individual test records in the logger is done with list-like instructions:
+\code{.Log$mytest} returns the 'svTestData' object named 'mytest', itself the
+result of running test in the 'mytest' test function (i.e, \code{runTest(mytest)},
+see hereunder). Assertions run at the command line, outside of specific contexts
+provided by test functions, test units and test suites (see hereunder) are
+recorded under the 'eval' 'svTestData' object in the logger (i.e., \code{.Log$eval}).
+
+Since a 'svSuiteData' object (the logger) is also an environment, you can get the
+list of all test records it contains using \code{ls(.Log)}, and you can eliminate
+a given test record using something like: \code{rm(mytest, envir = .Log)}.
+
+Test cases are collections of assertions with the satellite code needed
+to build example or situations to be tested. They are collected together in
+argument-less functions with class being 'svTest'. See \code{?svTest} for further
+explanations and a couple of example test cases/test functions.
+
+In its simplest instance, a test function is defined as a separate R object loaded
+in memory (unlike RUnit where all test must be defined in files). You run it
+simply by using \code{runTest(mytest)}. A slightly more structured way to work
+is to attach the test function to the object it testes. You use
+\code{test(myobj) <- testmyobj} to do so, and retrieve it with \code{test(myobj)}.
+Now, the test function always follows the tested object. Testing the object is
+still simple by using \code{runTest(myobj)}, which is totally equivalent to
+\code{runTest(test(myobj))}. One can determine if an object has a test function
+associated, or is a test function itself by using \code{is.test(myobj)}.
+
+Several test functions can be collected together in so-called test units. A test
+unit only exists on disk. It is a file named 'runit*.R' containing sourceable R
+code with test functions having names starting with 'test' (unlike RUnit, the
+default convention of file names starting with 'runit' and test function names
+starting with 'test' is not customizable in svUnit). One can also define
+special \code{.setUp()} and \code{.tearDown()} functions in the unit. The first
+function will be run before each test function, and the latter one will be run
+after it. Test units are created manually, or from a collection of objects with
+associated test functions loaded in an environment (usually .GlobalEnv) thanks
+to the \code{makeUnit()} method. These units should be mutually compatible with
+those used in the RUnit package (at least with its version 0.4-17).
+
+Test units defined for packages should be located in the package /runitTests subdirectory
+ (/inst/runitTests for source of the package) or one of its subdirectories. That
+way, they are located automatically by the function \code{svSuiteList()} that
+also automatically detects all objects with associated test functions loaded
+in .GlobalEnv. Test suites are 'svSuite' objects with a list of test units or
+test objects to collect in the suite. Thus, \code{svSuiteList()}
+automatically builds such a suite with all tests it finds in R, with many
+possibilities to filter packages' test units, objects' test functions, or to add
+non standard directories with test units, for instance. See \code{?svSuite} for
+more details on creating and using these suites.
+
+A GUI (Graphical User Interface) is provided to automatically build and
+run tests suites and to get a graphical (tree) interactive report of the results
+in the Komodo Edit code editor, together with the SciViews-K extension. If you
+want to use this (optional) GUI, visit http://www.sciviews/org/SciViews-K to
+install required software components on your machine.
+
+Finally, the svUnit framework is compatible with R CMD check (see the manual
+"Writing R extensions"). You simply define man pages (.Rd files) with an example
+section running selected test units from your package. The function
+\code{errorLog()} is designed to generate and error if one or more tests failed
+or raised an error during R CMD check, and it should be used at the end of the
+example that runs your unit test(s). That way, R CMD check is interrupted and a
+detailed report of the tests that failed or raised an error is printed. See an
+example in \code{?unitTests.svUnit}.
+}
+\author{
+Written by Ph. Grosjean, inspired from the general design of the 'RUnit' package
+by Thomas Konig, Klaus Junemann & Matthias Burger.
+
+Maintainer: Ph. Grosjean <phgrosjean at sciviews.org>
+}
+\references{
+There is a huge litterature and unit testing. An easy starting point is:
+http://en.wikipedia.org/wiki/Unit\_test.
+}
+
+\keyword{ package }
+\keyword{ utilities }
+
+\seealso{
+ \code{\link[RUnit]{RUnit}}
+}
+\examples{
+# Clear the logger
+clearLog()
+
+# Design and attach a simple test function to an object
+foo <- function(x, y = 2) return(x * y)
+testfoo <- function () {
+ #DEACTIVATED(); # Use this to deactive the test (notice placed in the log)
+ checkEqualsNumeric(5, foo(2), "Check return of foo()")
+ checkException(foo("b"), "Wrong first argument")
+ checkException(foo(2, "a"), "Wrong second argument")
+
+}
+# Attach this to the foo function
+test(foo) <- testfoo
+
+# Run this test
+runTest(foo)
+
+# Inspect the result
+ls(.Log)
+.Log$"test(foo)"
+# This test fails. You see that the test function requires that foo(2) = 5 and
+# the actual implementation returns 4. This is a trivial, useless example, but
+# you are supposed to correct the function. For instance:
+foo <- function(x, y = 2) return(x * y + 1)
+test(foo) <- testfoo
+
+(runTest(foo)) # Now, that's fine!
+}
Deleted: pkg/svUnit/man/svUnit.Rd
===================================================================
--- pkg/svUnit/man/svUnit.Rd 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/man/svUnit.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -1,131 +0,0 @@
-\name{svUnit}
-\alias{svUnit}
-\alias{as.svUnit}
-\alias{is.svUnit}
-\alias{svUnitList}
-\alias{print.svUnit}
-\alias{makeUnit.svUnit}
-\alias{runTest.svUnit}
-
-\title{ Create and run test units by collecting together RUnit tests and tests
- defined in objects }
-\description{
- A 'svUnit' object is essentially a list of test units directories, and of
- object names containing tests to add to the test unit. These must be formatted
- in a concise way as described for the 'tests' argument.
-
- \code{svUnitList()} lists all loaded packages having /unitTests/runit*.R files
- (or similar files in subdirectories), and all objects in the user workspace
- that have a 'test' attribute, or are 'svTest' objects (by default). It is a
- rather exhaustive list of all test items currently available in this session.
-
- \code{makeUnit()} writes a test unit on disk with the tests from the objects
- lised in 'svUnit'. \code{runTest()} runs all the test in packages, directories
- and objects listed in the 'svUnit' object.
-}
-
-\usage{
-svUnit(tests)
-
-as.svUnit(x)
-is.svUnit(x)
-
-svUnitList(packages = TRUE, objects = TRUE, pos = .GlobalEnv)
-
-\method{print}{svUnit}(x, \dots)
-\method{makeUnit}{svUnit}(x, name = make.names(deparse(substitute(x))),
- dir = tempdir(), pos = .GlobalEnv, \dots)
-\method{runTest}{svUnit}(x, name = make.names(deparse(substitute(x))), \dots)
-}
-
-\arguments{
- \item{tests}{ A character string with items to include in the test suite.
- It could be 'package:PKG' for including test units located in the /unitTests
- subdirectory of the package PGK, or 'package:PKG (SUITE)' for test units
- located in the subdirectory /unitTests/SUITE of package PKG, or 'dir:MYDIR'
- for including test units in MYDIR, or 'test(OBJ)' for tests embedded in an
- object, or 'OBJ' for 'svTest' object directly }
- \item{x}{ Any kind of object }
- \item{packages}{ Do we list test units available in loaded packages?
- Alternatively one can provide a character vector of package names, and it
- will be used to filter packages (take care: in this case it will look at
- installed packages, not only loaded packages!) }
- \item{objects}{ Do we list test available in objects? Alternatively, one can
- provide a character vector of object names, and it will filter objects in
- 'pos' according to this vector }
- \item{pos}{ The environment to look for 'objects' (environment, character
- string with name of an environment, or interger with position of the
- environment in the search path }
- \item{\dots}{ Further arguments to pass to \code{makeUnit()} and
- \code{defineTestsuite()} from the RUnit package }
- \item{name}{ The name of the test suite to build. }
- \item{dir}{ The directory where to create the test unit file }
-}
-
-\value{
- \code{svUnit()}, \code{as.svUnit()} and \code{svUnitList} return a 'svUnit'
- object. \code{is.svUnit()} returns \code{TRUE} if the object is an 'svUnit'.
-}
-
-\author{ Philippe Grosjean <phgrosjean at sciviews.org> }
-
-\seealso{ \code{\link{runUnit}}, \code{\link{svTest}},
- \code{\link[RUnit]{defineTestSuite}} }
-
-\examples{
-svUnitList() # List all currently available test units and test cases
-
-# Two functions that include their test cases
-Square <- function(x) return(x^2)
-test(Square) <- function() {
- checkEquals(Square(3), 9)
- checkEquals(Square(1:3), c(1, 4, 9))
- checkException(Square("xx"))
-}
-
-Cube <- function(x) return(x^3)
-test(Cube) <- function() {
- checkEquals(Cube(3), 27)
- checkEquals(Cube(1:3), c(1, 8, 28))
- checkException(Cube("xx"))
-}
-
-# A separate test case object
-test.R <- svTest(function() {
- checkTrue(1 < 2, "check1")
- v <- 1:3
- w <- 1:3
- checkEquals(v, w)
-})
-
-# A function without test cases
-foo <- function(x) return(x)
-
-# Look now what tests are available
-svUnitList()
-
-# Only objects, no package units
-svUnitList(packages = FALSE)
-
-\dontrun{
-# Create the test unit file for the objects
-unit <- makeUnit(svUnitList(), name = "AllTests")
-file.show(unit, delete.file = TRUE)
-}
-
-# Filter objects using a list
-svUnitList(objects = c("foo", "bar"))
-
-# Create another svUnit object with selected test items
-(myunit <- svUnit(c("package:svUnit (VirtualClass)", "test(foo)")))
-is.svUnit(myunit) # Should be!
-
-\dontrun{
-# Run all the tests
-summary(runTest(svUnitList(), name = "AllTests"))
-}
-
-rm(Square, Cube, foo, test.R, myunit, unit)
-}
-
-\keyword{ utilities }
Modified: pkg/svUnit/man/unitTests.Rd
===================================================================
--- pkg/svUnit/man/unitTests.Rd 2008-06-13 10:43:26 UTC (rev 11)
+++ pkg/svUnit/man/unitTests.Rd 2008-06-23 01:33:08 UTC (rev 12)
@@ -13,21 +13,21 @@
\examples{
# Make sure to clear log of errors and failures first
-unitClear()
+clearLog()
# Run all test units defined in the 'svUnit' package
-(runTest(svUnit("package:svUnit"), "svUnit"))
+(runTest(svSuite("package:svUnit"), "svUnit"))
\donttest{
# Tests to run with example() but not with R CMD check
# Run all test units defined in the /unitTests/VirtualClass subdir of 'svUnit'
-(runTest(svUnit("package:svUnit (VirtualClass)"), "VirtualClass"))
+(runTest(svSuite("package:svUnit (VirtualClass)"), "VirtualClass"))
}
\dontrun{
# Tests to present in ?unitTests.svUnit but to never run automatically
# Run all currently loaded test cases and test suites of all loaded packages
-(runTest(svUnitList(), "AllTests"))
+(runTest(svSuiteList(), "AllTests"))
}
\dontshow{
@@ -35,8 +35,8 @@
# or run with example(unitTests.svUnit)
}
-# Check errors at the end of the process (needed for R CMD check)
-unitError()
+# Check errors at the end of the process (needed to interrupt R CMD check)
+errorLog()
}
\keyword{utilities}
More information about the Sciviews-commits
mailing list