core/org.eclipse.statet.rj.server.rpkg/pkg/R/dbg.R

 #=============================================================================#
 # Copyright (c) 2011, 2021 Stephan Wahlbrink and others.
 # 
 # This program and the accompanying materials are made available under the
 # terms of the Eclipse Public License 2.0 which is available at
 # https://www.eclipse.org/legal/epl-2.0, or the Apache License, Version 2.0
 # which is available at https://www.apache.org/licenses/LICENSE-2.0.
 # 
 # SPDX-License-Identifier: EPL-2.0 OR Apache-2.0
 # 
 # Contributors:
 #     Stephan Wahlbrink <sw@wahlbrink.eu> - initial API and implementation
 #=============================================================================#


## RJ dbg


#' Initializes the debug tools
dbg.init <- function(...) {
	error("Operation not supported");
}


dbg.checkBreakpoint <- function() {
	if (tracingState(FALSE)) {
		on.exit(tracingState(TRUE));
	}
	
	answer <- .Call("Re_ExecJCommand", "dbg:checkBreakpoint", sys.call(), 0L,
			PACKAGE= "(embedding)" );
	
	if (!is.null(answer)) {
		envir <- sys.frame(-1);
		eval(expr= answer, envir= envir);
	}
}

dbg.checkEB <- function() {
	if (tracingState(FALSE)) {
		on.exit(tracingState(TRUE));
	}
	
	if ("rj" %in% loadedNamespaces()) {
		answer <- .Call("Re_ExecJCommand", "dbg:checkEB", NULL, 0L,
				PACKAGE= "(embedding)" );
		
		if (!is.null(answer)) {
			envir <- sys.frame(-1);
			eval(expr= answer, envir= envir);
		}
	}
}

dbg.checkTB <- function(expr, env) {
	answer <- .Call("Re_ExecJCommand", "dbg:checkTB", list(expr, env), 0L,
			PACKAGE= "(embedding)" );
}


dbg.registerEnv <- function(key, env, objectNames= NULL) {
	.Call("Re_ExecJCommand", "dbg:registerEnv", list(key, env, objectNames), 0L,
			PACKAGE= "(embedding)" );
	return (invisible());
}

dbg.unregisterEnvs <- function(key) {
	.Call("Re_ExecJCommand", "dbg:unregisterEnvs", list(key), 0L,
			PACKAGE= "(embedding)" );
	return (invisible());
}


dbg.updateTracepoints <- function(env, objectNames= NULL) {
	.Call("Re_ExecJCommand", "dbg:updateTracepoints", list(env, objectNames), 0L,
			PACKAGE= "(embedding)" );
	return (invisible());
}


equalsTimestamp <- function(t1, t2) {
	return (t1 == t2
			|| (diff<- abs(round(t1 - t2))) == 0
			|| diff == 3600 );
}