/* * R : A Computer Language for Statistical Data Analysis * file util.c * Copyright (C) 2005--2023 The R Core Team * Copyright (C) 1998--2003 Guido Masarotto and Brian Ripley * Copyright (C) 2004 The R Foundation * * 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 "win-nls.h" /* FIXME: This should include utils.h to force consistency. */ typedef void (WINAPI *PGNSI)(LPSYSTEM_INFO); // keep in step with src/gnuwin32/extra.c SEXP winver(void) { char ver[256]; OSVERSIONINFOEX osvi; osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX); if(!GetVersionEx((OSVERSIONINFO *)&osvi)) error(_("unsupported version of Windows")); /* see http://msdn2.microsoft.com/en-us/library/ms724429.aspx for ways to get more info. Pre-NT versions are all 4.x, so no need to separate test. See also http://msdn.microsoft.com/en-us/library/ms724832.aspx https://msdn.microsoft.com/en-us/library/windows/desktop/ms724833%28v=vs.85%29.aspx for version number naming. */ if(osvi.dwMajorVersion >= 5) { char *desc = "", *type=""; SYSTEM_INFO si; // future-proof snprintf(ver, 256, "%d.%d", (int) osvi.dwMajorVersion, (int) osvi.dwMinorVersion); if(osvi.dwMajorVersion == 10) { /* need to differentiate by build number */ if(osvi.wProductType == VER_NT_WORKSTATION) { if(osvi.dwBuildNumber >= 22000) desc = "11"; else desc = "10"; } else { if(osvi.dwBuildNumber >= 20348) desc = "Server 2022"; else if(osvi.dwBuildNumber >= 17763) desc = "Server 2019"; else desc = "Server 2016"; } } else if(osvi.dwMajorVersion == 6) { if(osvi.wProductType == VER_NT_WORKSTATION) { if(osvi.dwMinorVersion == 0) desc = "Vista"; else if(osvi.dwMinorVersion == 1) desc = "7"; else if(osvi.dwMinorVersion == 2) desc = "8"; else if(osvi.dwMinorVersion == 3) desc = "8.1"; else desc = "> 8.1"; } else { if(osvi.dwMinorVersion == 0) desc = "Server 2008"; else if(osvi.dwMinorVersion == 1) desc = "Server 2008 R2"; else if(osvi.dwMinorVersion == 2) desc = "Server 2012"; else if(osvi.dwMinorVersion == 3) desc = "Server 2012 R2"; else desc = "Server > 2012 R2"; } } else if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0) desc = "2000"; else if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 1) desc = "XP"; else if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2) { if(osvi.wProductType == VER_NT_WORKSTATION) desc = "XP Professional"; else desc = "Server 2003"; } /* GetNativeSystemInfo is XP or later */ GetNativeSystemInfo(&si); if(si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64) type = " x64"; if(osvi.wServicePackMajor > 0) snprintf(ver, 256, "Windows %s%s (build %d) Service Pack %d", desc, type, LOWORD(osvi.dwBuildNumber), (int) osvi.wServicePackMajor); else snprintf(ver, 256, "Windows %s%s (build %d)", desc, type, LOWORD(osvi.dwBuildNumber)); } else { /* should not get here */ snprintf(ver, 256, "Windows %d.%d (build %d) %s", (int) osvi.dwMajorVersion, (int) osvi.dwMinorVersion, LOWORD(osvi.dwBuildNumber), osvi.szCSDVersion); } return mkString(ver); } SEXP dllversion(SEXP path) { const wchar_t *dll; DWORD dwVerInfoSize; DWORD dwVerHnd; if(!isString(path) || LENGTH(path) != 1) error(_("invalid '%s' argument"), "path"); dll = filenameToWchar(STRING_ELT(path, 0), FALSE); dwVerInfoSize = GetFileVersionInfoSizeW(dll, &dwVerHnd); SEXP ans = PROTECT(allocVector(STRSXP, 2)); SET_STRING_ELT(ans, 0, mkChar("")); SET_STRING_ELT(ans, 1, mkChar("")); if (dwVerInfoSize) { BOOL fRet; LPSTR lpstrVffInfo; LPSTR lszVer = NULL; UINT cchVer = 0; lpstrVffInfo = (LPSTR) malloc(dwVerInfoSize); if (GetFileVersionInfoW(dll, 0L, dwVerInfoSize, lpstrVffInfo)) { fRet = VerQueryValue(lpstrVffInfo, TEXT("\\StringFileInfo\\040904E4\\FileVersion"), (LPVOID)&lszVer, &cchVer); if(fRet) SET_STRING_ELT(ans, 0, mkChar(lszVer)); fRet = VerQueryValue(lpstrVffInfo, TEXT("\\StringFileInfo\\040904E4\\R Version"), (LPVOID)&lszVer, &cchVer); if(fRet) SET_STRING_ELT(ans, 1, mkChar(lszVer)); else { fRet = VerQueryValue(lpstrVffInfo, TEXT("\\StringFileInfo\\040904E4\\Compiled under R Version"), (LPVOID)&lszVer, &cchVer); if(fRet) SET_STRING_ELT(ans, 1, mkChar(lszVer)); } } else ans = R_NilValue; free(lpstrVffInfo); } else ans = R_NilValue; UNPROTECT(1); return ans; } SEXP getClipboardFormats(void) { SEXP ans = R_NilValue; int j, size, format = 0; if(OpenClipboard(NULL)) { size = CountClipboardFormats(); PROTECT(ans = allocVector(INTSXP, size)); for (j = 0; j < size; j++) { format = EnumClipboardFormats(format); INTEGER(ans)[j] = format; } UNPROTECT(1); CloseClipboard(); } return ans; } #define STRICT_R_HEADERS #include /* split on \r\n or just one */ static SEXP splitClipboardText(const char *s, int ienc) { int cnt_r= 0, cnt_n = 0, n, nc, nl, line_len = 0; const char *p; char *line, *q, eol = '\n'; Rboolean last = TRUE; /* does final line have EOL */ Rboolean CRLF = FALSE; SEXP ans; for(p = s, nc = 0; *p; p++, nc++) switch(*p) { case '\n': cnt_n++; last = TRUE; line_len = max(line_len, nc); nc = -1; break; case '\r': cnt_r++; last = TRUE; break; default: last = FALSE; } if (!last) line_len = max(line_len, nc); /* the unterminated last might be the longest */ n = max(cnt_n, cnt_r) + (last ? 0 : 1); if (cnt_n == 0 && cnt_r > 0) eol = '\r'; if (cnt_r == cnt_n) CRLF = TRUE; /* over-allocate a line buffer */ line = R_chk_calloc(1+line_len, 1); PROTECT(ans = allocVector(STRSXP, n)); for(p = s, q = line, nl = 0; *p; p++) { if (*p == eol) { *q = '\0'; SET_STRING_ELT(ans, nl++, mkCharCE(line, ienc)); q = line; *q = '\0'; } else if(CRLF && *p == '\r') ; else *q++ = *p; } if (!last) { *q = '\0'; SET_STRING_ELT(ans, nl, mkCharCE(line, ienc)); } R_chk_free(line); UNPROTECT(1); return(ans); } SEXP readClipboard(SEXP sformat, SEXP sraw) { SEXP ans = R_NilValue; HGLOBAL hglb; const char *pc; int j, format, raw, size; format = asInteger(sformat); raw = asLogical(sraw); if(OpenClipboard(NULL)) { if(IsClipboardFormatAvailable(format) && (hglb = GetClipboardData(format)) && (pc = (const char *) GlobalLock(hglb))) { if(raw) { Rbyte *pans; size = GlobalSize(hglb); ans = allocVector(RAWSXP, size); /* no R allocation below */ pans = RAW(ans); for (j = 0; j < size; j++) pans[j] = *pc++; } else if (format == CF_UNICODETEXT) { int n, ienc = CE_NATIVE; const wchar_t *wpc = (wchar_t *) pc; n = wcslen(wpc); char text[4*n+1]; R_CheckStack(); wcstoutf8(text, wpc, sizeof(text)); if(!strIsASCII(text)) ienc = CE_UTF8; ans = splitClipboardText(text, ienc); } else if (format == CF_TEXT || format == CF_OEMTEXT || format == CF_DIF) { /* can we get the encoding out of a CF_LOCALE entry? */ ans = splitClipboardText(pc, 0); } else error("'raw = FALSE' and format is a not a known text format"); GlobalUnlock(hglb); } CloseClipboard(); } return ans; } SEXP writeClipboard(SEXP text, SEXP sformat) { int i, n, format; HGLOBAL hglb; char *s; const char *p; Rboolean success = FALSE, raw = FALSE; const void *vmax = vmaxget(); format = asInteger(sformat); if (TYPEOF(text) == RAWSXP) raw = TRUE; else if(!isString(text)) error(_("argument must be a character vector or a raw vector")); n = length(text); if(n > 0) { int len = 1; if(raw) len = n; else if (format == CF_UNICODETEXT) for(i = 0; i < n; i++) len += 2 * (wcslen(wtransChar(STRING_ELT(text, i))) + 2); else if (format == CF_TEXT || format == CF_OEMTEXT || format == CF_DIF) for(i = 0; i < n; i++) len += strlen(translateChar(STRING_ELT(text, i))) + 2; else error("'raw = FALSE' and format is a not a known text format"); if ( (hglb = GlobalAlloc(GHND, len)) && (s = (char *)GlobalLock(hglb)) ) { if(raw) for(i = 0; i < n; i++) *s++ = RAW(text)[i]; else if (format == CF_UNICODETEXT) { const wchar_t *wp; wchar_t *ws = (wchar_t *) s; for(i = 0; i < n; i++) { wp = wtransChar(STRING_ELT(text, i)); while(*wp) *ws++ = *wp++; *ws++ = L'\r'; *ws++ = L'\n'; } *ws = L'\0'; } else { for(i = 0; i < n; i++) { p = translateChar(STRING_ELT(text, i)); while(*p) *s++ = *p++; *s++ = '\r'; *s++ = '\n'; } *s = '\0'; } GlobalUnlock(hglb); if (!OpenClipboard(NULL) || !EmptyClipboard()) { warning(_("unable to open the clipboard")); GlobalFree(hglb); } else { success = SetClipboardData(format, hglb) != 0; if(!success) { warning(_("unable to write to the clipboard")); GlobalFree(hglb); } CloseClipboard(); } } } vmaxset(vmax); return ScalarLogical(success); } #include "Startup.h" #include #include "rui.h" SEXP getIdentification(void) { const char *res = "" /* -Wall */; switch(CharacterMode) { case RGui: if(RguiMDI & RW_MDI) res = "RGui"; else res = "R Console"; break; case RTerm: res = "Rterm"; break; default: /* do nothing */ break; /* -Wall */ } return mkString(res); } SEXP getWindowTitle(void) { char buf[512], *res = ""; switch(CharacterMode) { case RGui: if(RguiMDI & RW_MDI) res = GA_gettext(RFrame); else res = GA_gettext(RConsole); break; case RTerm: GetConsoleTitle(buf, 512); buf[511] = '\0'; res = buf; break; default: /* do nothing */ break; } return mkString(res); } static SEXP in_setTitle(const char *title) { SEXP result = getWindowTitle(); switch(CharacterMode) { case RGui: if(RguiMDI & RW_MDI) settext(RFrame, title); else settext(RConsole, title); break; case RTerm: SetConsoleTitle(title); break; default: /* do nothing */ break; /* -Wall */ } return result; } SEXP setWindowTitle(SEXP title) { if(!isString(title) || LENGTH(title) != 1 || STRING_ELT(title, 0) == NA_STRING) error(_("'title' must be a character string")); return in_setTitle(translateChar(STRING_ELT(title, 0))); } SEXP setStatusBar(SEXP text) { if(!isString(text) || LENGTH(text) != 1 || STRING_ELT(text, 0) == NA_STRING) error(_("'text' must be a character string")); showstatusbar(); setstatus(translateChar(STRING_ELT(text, 0))); return R_NilValue; } static void * getConsoleHandle(const char *which) { if (CharacterMode != RGui) return(NULL); else if (strcmp(which, "Console") == 0 && RConsole) return getHandle(RConsole); else if (strcmp(which, "Frame") == 0 && RFrame) return getHandle(RFrame); else if (strcmp(which, "Process") == 0) return GetCurrentProcess(); else return NULL; } #include #include "devWindows.h" static void *getDeviceHandle(int dev) { pGEDevDesc gdd; gadesc *xd; if (dev == -1) return(getHandle(RConsole)); if (dev < 1 || dev > R_MaxDevices || dev == NA_INTEGER) return(0); gdd = GEgetDevice(dev - 1); if (!gdd) return(NULL); xd = (gadesc *) gdd->dev->deviceSpecific; if (!xd) return(NULL); return getHandle(xd->gawin); } SEXP getWindowsHandle(SEXP which) { void * handle; if(length(which) != 1) error(_("'%s' must be length 1"), "which"); if (isString(which)) handle = getConsoleHandle(CHAR(STRING_ELT(which,0))); else if (isInteger(which)) handle = getDeviceHandle(INTEGER(which)[0]); else handle = NULL; if (handle) return R_MakeExternalPtr(handle,R_NilValue,R_NilValue); else return R_NilValue; } static SEXP EnumResult; static int EnumCount; static PROTECT_INDEX EnumIndex; static int EnumMinimized; static DWORD EnumProcessId; static BOOL CALLBACK EnumWindowsProc(HWND handle, LPARAM param) { char title[1024]; if (IsWindowVisible(handle)) { if (EnumProcessId) { /* restrict to R windows only */ DWORD processId; GetWindowThreadProcessId(handle, &processId); if (processId != EnumProcessId) return TRUE; } if (!EnumMinimized && IsIconic(handle)) return TRUE; if (EnumCount >= length(EnumResult)) { int newlen = 2*length(EnumResult); REPROTECT(EnumResult = lengthgets(EnumResult, newlen), EnumIndex); setAttrib(EnumResult, R_NamesSymbol, lengthgets(getAttrib(EnumResult, R_NamesSymbol), newlen)); } SET_VECTOR_ELT(EnumResult, EnumCount, R_MakeExternalPtr(handle,R_NilValue,R_NilValue)); if (GetWindowText(handle, title, 1024)) SET_STRING_ELT(getAttrib(EnumResult, R_NamesSymbol), EnumCount, mkChar(title)); EnumCount++; } return TRUE; } SEXP getWindowsHandles(SEXP which, SEXP minimized) { PROTECT_WITH_INDEX(EnumResult = allocVector(VECSXP, 8), &EnumIndex); setAttrib(EnumResult, R_NamesSymbol, allocVector(STRSXP, 8)); EnumCount = 0; const char * w; w = CHAR(STRING_ELT(which, 0)); EnumMinimized = asLogical(minimized); if (strcmp(w, "R") == 0) EnumProcessId = GetCurrentProcessId(); else EnumProcessId = 0; if (ismdi() && EnumProcessId) EnumChildWindows(GetParent(getHandle(RConsole)), EnumWindowsProc, 0); else EnumWindows(EnumWindowsProc, 0); EnumResult = lengthgets(EnumResult, EnumCount); UNPROTECT(1); return EnumResult; } static void in_ArrangeWindows(int n, void** windows, int action, int preserve, int outer) { int j; if (action == MINIMIZE || action == RESTORE) { for (j=0; j