[Rcpp-commits] r2489 - in pkg/Rcpp: . R inst/include/Rcpp/module

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-11-22 15:59:44 +0100 (Mon, 22 Nov 2010)
New Revision: 2489

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/R/00_classes.R
   pkg/Rcpp/R/01_show.R
   pkg/Rcpp/R/Module.R
   pkg/Rcpp/inst/include/Rcpp/module/Module_Property.h
Log:
nicer show( C++Class )

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2010-11-22 12:09:51 UTC (rev 2488)
+++ pkg/Rcpp/ChangeLog	2010-11-22 14:59:44 UTC (rev 2489)
@@ -1,5 +1,10 @@
 2010-11-22  Romain Francois <romain at r-enthusiasts.com>
 
+    * R/00_classes.R: C++OverloadedMethods gains an "info" class methods, factored
+    out from Module.R
+    
+    * R/01_show.R: more information printed in show( C++Class )
+
     * inst/include/Rcpp/Module/Module_generated_get_signature.h: templates to
     grab method signatures
     

Modified: pkg/Rcpp/R/00_classes.R
===================================================================
--- pkg/Rcpp/R/00_classes.R	2010-11-22 12:09:51 UTC (rev 2488)
+++ pkg/Rcpp/R/00_classes.R	2010-11-22 14:59:44 UTC (rev 2489)
@@ -41,6 +41,11 @@
         void          = "logical", 
         docstrings    = "character", 
         signatures    = "character"
+    ), 
+    methods = list( 
+        info = function(prefix = "    " ){
+             paste( paste( prefix, signatures, "\n", prefix, prefix, "docstring :", docstrings) , collapse = "\n" )   
+        }
     )
 )
 

Modified: pkg/Rcpp/R/01_show.R
===================================================================
--- pkg/Rcpp/R/01_show.R	2010-11-22 12:09:51 UTC (rev 2488)
+++ pkg/Rcpp/R/01_show.R	2010-11-22 14:59:44 UTC (rev 2489)
@@ -39,11 +39,30 @@
 		externalptr_address(object at pointer) )
 	writeLines( txt )
 	
-	met <- .Call( CppClass__methods, object at pointer )
-	if( length( met ) ){
-		txt <- sprintf( "\n%d methods : \n%s", length(met), paste( sprintf("    %s", met), collapse = "\n") )
-		writeLines( txt )
+	fields <- object at fields
+	nfields <- length(fields)
+	names <- names(fields)
+	txt <- character(nfields)
+	for( i in seq_len(nfields) ){
+	    f <- fields[[i]]
+	    txt[i] <- sprintf( "    %s %s%s",
+	        f$cpp_class, 
+	        names[i], 
+	        if( f$read_only ) " [readonly]" else "" 
+	    )    
 	}
+	# TODO: pull out reflection info about constructors
+	writeLines( "Fields: " )
+	writeLines( paste( txt, collapse = "\n" ) )
+	
+	writeLines( "\nMethods: " )
+	mets <- object at methods
+	nmethods <- length(mets)
+	txt <- character( nmethods )
+	for( i in seq_len(nmethods) ){
+	    txt[i] <- mets[[i]]$info("    ")
+	}
+	writeLines( paste( txt, collapse = "\n" ) )
 } )
 
 setMethod( "show", "C++Function", function(object){

Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R	2010-11-22 12:09:51 UTC (rev 2488)
+++ pkg/Rcpp/R/Module.R	2010-11-22 14:59:44 UTC (rev 2489)
@@ -221,7 +221,7 @@
             CppMethod__invoke_void = CppMethod__invoke_void,
             CppMethod__invoke_notvoid = CppMethod__invoke_notvoid,
             dealWith = dealWith, 
-            docstring = paste( paste( METHOD$signatures, "\n\tdocstring :", METHOD$docstrings) , collapse = "\n" )
+            docstring = METHOD$info("")
         )
         
         extCall <- if( all( METHOD$void ) ){

Modified: pkg/Rcpp/inst/include/Rcpp/module/Module_Property.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/module/Module_Property.h	2010-11-22 12:09:51 UTC (rev 2488)
+++ pkg/Rcpp/inst/include/Rcpp/module/Module_Property.h	2010-11-22 14:59:44 UTC (rev 2489)
@@ -34,7 +34,8 @@
 		SEXP get(Class* object) throw(std::range_error){ return Rcpp::wrap( (object->*getter)() ) ; }
 		void set(Class*, SEXP) throw(std::range_error,Rcpp::not_compatible){ throw std::range_error("property is read only") ; }		
 		bool is_readonly(){ return true ; }
-		
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		std::string class_name ;
@@ -53,7 +54,8 @@
 		SEXP get(Class* object) throw(std::range_error){ return Rcpp::wrap( (object->*getter)() ) ; }
 		void set(Class*, SEXP) throw(std::range_error,Rcpp::not_compatible){ throw std::range_error("property is read only") ; }		
 		bool is_readonly(){ return true ; }
-
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		std::string class_name ;
@@ -73,7 +75,8 @@
 		SEXP get(Class* object) throw(std::range_error){ return Rcpp::wrap( getter(object) ) ; }
 		void set(Class*, SEXP) throw(std::range_error,Rcpp::not_compatible){ throw std::range_error("property is read only") ; }		
 		bool is_readonly(){ return true ; }
-
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		std::string class_name ;				
@@ -99,7 +102,8 @@
 			) ;
 		}		
 		bool is_readonly(){ return false ; }
-
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		SetMethod setter ;
@@ -123,7 +127,8 @@
 			) ;
 		}		
 		bool is_readonly(){ return false ; }
-
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		SetMethod setter ;
@@ -153,7 +158,8 @@
 			) ;
 		}		
 		bool is_readonly(){ return false ; }
-
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		SetMethod setter ;
@@ -178,7 +184,8 @@
 			) ;
 		}		
 		bool is_readonly(){ return false ; }
-
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		SetMethod setter ;
@@ -205,7 +212,8 @@
 			) ;
 		}		
 		bool is_readonly(){ return false ; }
-
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		SetMethod setter ;
@@ -233,7 +241,8 @@
 			) ;
 		}		
 		bool is_readonly(){ return false ; }
-
+		std::string get_class(){ return class_name; }
+			
 	private:
 		GetMethod getter ;
 		SetMethod setter ;