/* * R : A Computer Language for Statistical Data Analysis * Copyright (C) 1999-2012 The R Core Team * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, a copy is available at * https://www.R-project.org/Licenses/ */ #ifdef HAVE_CONFIG_H # include #endif #include #include #include #include #ifdef HAVE_X11 #include /* typedefs for the module routine types */ static R_X11Routines routines, *ptr = &routines; static int initialized = 0; R_X11Routines * R_setX11Routines(R_X11Routines *routines) { R_X11Routines *tmp; tmp = ptr; ptr = routines; return tmp; } attribute_hidden int R_X11_Init(void) { int res; if(initialized) return initialized; initialized = -1; if(strcmp(R_GUIType, "none") == 0) { warning(_("X11 module is not available under this GUI")); return initialized; } res = R_moduleCdynload("R_X11", 1, 1); if(!res) return initialized; if(!ptr->access) error(_("X11 routines cannot be accessed in module")); initialized = 1; return initialized; } attribute_hidden Rboolean R_access_X11(void) { R_X11_Init(); return (initialized > 0) ? (*ptr->access)() > 0 : FALSE; } // called from src/library/grDevices/src/stubs.c SEXP do_X11(SEXP call, SEXP op, SEXP args, SEXP rho) { R_X11_Init(); if(initialized > 0) return (*ptr->X11)(call, op, args, rho); else { error(_("X11 module cannot be loaded")); return R_NilValue; } } // called from src/library/grDevices/src/stubs.c SEXP do_saveplot(SEXP call, SEXP op, SEXP args, SEXP rho) { R_X11_Init(); if(initialized > 0) return (*ptr->saveplot)(call, op, args, rho); else { error(_("X11 module cannot be loaded")); return R_NilValue; } } // exported for src/include/R_ext/GetX11Image.h (and package tkrplot) Rboolean R_GetX11Image(int d, void *pximage, int *pwidth, int *pheight) { R_X11_Init(); if(initialized > 0) return (*ptr->image)(d, pximage, pwidth, pheight); else { error(_("X11 module cannot be loaded")); return FALSE; } } attribute_hidden Rboolean R_ReadClipboard(Rclpconn clpcon, char *type) { R_X11_Init(); if(initialized > 0) return (*ptr->readclp)(clpcon, type); else { error(_("X11 module cannot be loaded")); return FALSE; } } SEXP do_bmVersion(void) { SEXP ans = PROTECT(allocVector(STRSXP, 3)), nms = PROTECT(allocVector(STRSXP, 3)); setAttrib(ans, R_NamesSymbol, nms); SET_STRING_ELT(nms, 0, mkChar("libpng")); SET_STRING_ELT(nms, 1, mkChar("jpeg")); SET_STRING_ELT(nms, 2, mkChar("libtiff")); R_X11_Init(); if(initialized > 0) { SET_STRING_ELT(ans, 0, mkChar((*ptr->R_pngVersion)())); SET_STRING_ELT(ans, 1, mkChar((*ptr->R_jpegVersion)())); SET_STRING_ELT(ans, 2, mkChar((*ptr->R_tiffVersion)())); } UNPROTECT(2); return ans; } #else /* No HAVE_X11 */ attribute_hidden Rboolean R_access_X11(void) { return FALSE; } SEXP do_X11(SEXP call, SEXP op, SEXP args, SEXP rho) { error(_("X11 is not available")); return R_NilValue; } SEXP do_saveplot(SEXP call, SEXP op, SEXP args, SEXP rho) { error(_("X11 is not available")); return R_NilValue; } Rboolean R_GetX11Image(int d, void *pximage, int *pwidth, int *pheight) { error(_("X11 is not available")); return FALSE; } attribute_hidden Rboolean R_ReadClipboard(Rclpconn con, char *type) { error(_("X11 is not available")); return FALSE; } SEXP do_bmVersion(void) { SEXP ans = PROTECT(allocVector(STRSXP, 3)), nms = PROTECT(allocVector(STRSXP, 3)); setAttrib(ans, R_NamesSymbol, nms); SET_STRING_ELT(nms, 0, mkChar("libpng")); SET_STRING_ELT(nms, 1, mkChar("jpeg")); SET_STRING_ELT(nms, 2, mkChar("libtiff")); UNPROTECT(2); return ans; } #endif