1 /*
2 * R : A Computer Language for Statistical Data Analysis
3 * file util.c
4 * Copyright (C) 2005--2019 The R Core Team
5 * Copyright (C) 1998--2003 Guido Masarotto and Brian Ripley
6 * Copyright (C) 2004 The R Foundation
7 *
8 * This program is free software; you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation; either version 2 of the License, or
11 * (at your option) any later version.
12 *
13 * This program is distributed in the hope that it will be useful,
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 * GNU General Public License for more details.
17 *
18 * You should have received a copy of the GNU General Public License
19 * along with this program; if not, a copy is available at
20 * https://www.R-project.org/Licenses/
21 */
22
23 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
26
27 #include <Defn.h>
28 #include <windows.h>
29
30 #include "win-nls.h"
31
32 /* FIXME:
33 This should include utils.h to force consistency.
34 */
35
36 typedef void (WINAPI *PGNSI)(LPSYSTEM_INFO);
37
38 // keep in step with src/gnuwin32/extra.c
winver(void)39 SEXP winver(void)
40 {
41 char ver[256];
42 OSVERSIONINFOEX osvi;
43
44 osvi.dwOSVersionInfoSize = sizeof(OSVERSIONINFOEX);
45 if(!GetVersionEx((OSVERSIONINFO *)&osvi))
46 error(_("unsupported version of Windows"));
47
48 /* see http://msdn2.microsoft.com/en-us/library/ms724429.aspx
49 for ways to get more info.
50 Pre-NT versions are all 4.x, so no need to separate test.
51 See also http://msdn.microsoft.com/en-us/library/ms724832.aspx
52 https://msdn.microsoft.com/en-us/library/windows/desktop/ms724833%28v=vs.85%29.aspx
53 for version number naming.
54 */
55 if(osvi.dwMajorVersion >= 5) {
56 char *desc = "", *type="";
57 SYSTEM_INFO si;
58 // future-proof
59 snprintf(ver, 256, "%d.%d",
60 (int) osvi.dwMajorVersion, (int) osvi.dwMinorVersion);
61 if(osvi.dwMajorVersion == 10) {
62 if(osvi.wProductType == VER_NT_WORKSTATION) desc = "10";
63 else desc = "Server";
64 } else if(osvi.dwMajorVersion == 6) {
65 // see See https://msdn.microsoft.com/en-us/library/windows/desktop/ms724451%28v=vs.85%29.aspx for the >= here.
66 if(osvi.wProductType == VER_NT_WORKSTATION) {
67 if(osvi.dwMinorVersion == 0) desc = "Vista";
68 else if(osvi.dwMinorVersion == 1) desc = "7";
69 else if(osvi.dwMinorVersion == 2) desc = ">= 8";
70 else if(osvi.dwMinorVersion == 3) desc = "8.1";
71 else desc = "> 8.1";
72 } else {
73 if(osvi.dwMinorVersion == 0) desc = "Server 2008";
74 else if(osvi.dwMinorVersion == 1) desc = "Server 2008 R2";
75 else if(osvi.dwMinorVersion == 2) desc = "Server >= 2012";
76 else if(osvi.dwMinorVersion == 3) desc = "Server 2012 R2";
77 else desc = "Server > 2012";
78 }
79 } else if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 0)
80 desc = "2000";
81 else if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 1)
82 desc = "XP";
83 else if(osvi.dwMajorVersion == 5 && osvi.dwMinorVersion == 2) {
84 if(osvi.wProductType == VER_NT_WORKSTATION)
85 desc = "XP Professional";
86 else
87 desc = "Server 2003";
88 }
89 /* GetNativeSystemInfo is XP or later */
90 GetNativeSystemInfo(&si);
91 if(si.wProcessorArchitecture == PROCESSOR_ARCHITECTURE_AMD64)
92 type = " x64";
93
94 if(osvi.wServicePackMajor > 0)
95 snprintf(ver, 256,
96 "Windows %s%s (build %d) Service Pack %d",
97 desc, type,
98 LOWORD(osvi.dwBuildNumber),
99 (int) osvi.wServicePackMajor);
100 else
101 snprintf(ver, 256,
102 "Windows %s%s (build %d)",
103 desc, type,
104 LOWORD(osvi.dwBuildNumber));
105 } else { /* should not get here */
106 snprintf(ver, 256, "Windows %d.%d (build %d) %s",
107 (int) osvi.dwMajorVersion, (int) osvi.dwMinorVersion,
108 LOWORD(osvi.dwBuildNumber), osvi.szCSDVersion);
109 }
110
111 return mkString(ver);
112 }
113
dllversion(SEXP path)114 SEXP dllversion(SEXP path)
115 {
116 const wchar_t *dll;
117 DWORD dwVerInfoSize;
118 DWORD dwVerHnd;
119
120 if(!isString(path) || LENGTH(path) != 1)
121 error(_("invalid '%s' argument"), "path");
122 dll = filenameToWchar(STRING_ELT(path, 0), FALSE);
123 dwVerInfoSize = GetFileVersionInfoSizeW(dll, &dwVerHnd);
124 SEXP ans = PROTECT(allocVector(STRSXP, 2));
125 SET_STRING_ELT(ans, 0, mkChar(""));
126 SET_STRING_ELT(ans, 1, mkChar(""));
127 if (dwVerInfoSize) {
128 BOOL fRet;
129 LPSTR lpstrVffInfo;
130 LPSTR lszVer = NULL;
131 UINT cchVer = 0;
132
133 lpstrVffInfo = (LPSTR) malloc(dwVerInfoSize);
134 if (GetFileVersionInfoW(dll, 0L, dwVerInfoSize, lpstrVffInfo)) {
135
136 fRet = VerQueryValue(lpstrVffInfo,
137 TEXT("\\StringFileInfo\\040904E4\\FileVersion"),
138 (LPVOID)&lszVer, &cchVer);
139 if(fRet) SET_STRING_ELT(ans, 0, mkChar(lszVer));
140
141 fRet = VerQueryValue(lpstrVffInfo,
142 TEXT("\\StringFileInfo\\040904E4\\R Version"),
143 (LPVOID)&lszVer, &cchVer);
144 if(fRet) SET_STRING_ELT(ans, 1, mkChar(lszVer));
145 else {
146 fRet = VerQueryValue(lpstrVffInfo,
147 TEXT("\\StringFileInfo\\040904E4\\Compiled under R Version"),
148 (LPVOID)&lszVer, &cchVer);
149 if(fRet) SET_STRING_ELT(ans, 1, mkChar(lszVer));
150 }
151
152 } else ans = R_NilValue;
153 free(lpstrVffInfo);
154 } else ans = R_NilValue;
155 UNPROTECT(1);
156 return ans;
157 }
158
getClipboardFormats(void)159 SEXP getClipboardFormats(void)
160 {
161 SEXP ans = R_NilValue;
162 int j, size, format = 0;
163
164 if(OpenClipboard(NULL)) {
165 size = CountClipboardFormats();
166 PROTECT(ans = allocVector(INTSXP, size));
167 for (j = 0; j < size; j++) {
168 format = EnumClipboardFormats(format);
169 INTEGER(ans)[j] = format;
170 }
171 UNPROTECT(1);
172 CloseClipboard();
173 }
174 return ans;
175 }
176
177 #define STRICT_R_HEADERS
178 #include <R_ext/RS.h>
179
180 /* split on \r\n or just one */
splitClipboardText(const char * s,int ienc)181 static SEXP splitClipboardText(const char *s, int ienc)
182 {
183 int cnt_r= 0, cnt_n = 0, n, nc, nl, line_len = 0;
184 const char *p;
185 char *line, *q, eol = '\n';
186 Rboolean last = TRUE; /* does final line have EOL */
187 Rboolean CRLF = FALSE;
188 SEXP ans;
189
190 for(p = s, nc = 0; *p; p++, nc++)
191 switch(*p) {
192 case '\n':
193 cnt_n++;
194 last = TRUE;
195 line_len = max(line_len, nc);
196 nc = -1;
197 break;
198 case '\r':
199 cnt_r++;
200 last = TRUE;
201 break;
202 default:
203 last = FALSE;
204 }
205 if (!last) line_len = max(line_len, nc); /* the unterminated last might be the longest */
206 n = max(cnt_n, cnt_r) + (last ? 0 : 1);
207 if (cnt_n == 0 && cnt_r > 0) eol = '\r';
208 if (cnt_r == cnt_n) CRLF = TRUE;
209 /* over-allocate a line buffer */
210 line = R_chk_calloc(1+line_len, 1);
211 PROTECT(ans = allocVector(STRSXP, n));
212 for(p = s, q = line, nl = 0; *p; p++) {
213 if (*p == eol) {
214 *q = '\0';
215 SET_STRING_ELT(ans, nl++, mkCharCE(line, ienc));
216 q = line;
217 *q = '\0';
218 } else if(CRLF && *p == '\r')
219 ;
220 else *q++ = *p;
221 }
222 if (!last) {
223 *q = '\0';
224 SET_STRING_ELT(ans, nl, mkCharCE(line, ienc));
225 }
226 R_chk_free(line);
227 UNPROTECT(1);
228 return(ans);
229 }
230
readClipboard(SEXP sformat,SEXP sraw)231 SEXP readClipboard(SEXP sformat, SEXP sraw)
232 {
233 SEXP ans = R_NilValue;
234 HGLOBAL hglb;
235 const char *pc;
236 int j, format, raw, size;
237
238 format = asInteger(sformat);
239 raw = asLogical(sraw);
240
241 if(OpenClipboard(NULL)) {
242 if(IsClipboardFormatAvailable(format) &&
243 (hglb = GetClipboardData(format)) &&
244 (pc = (const char *) GlobalLock(hglb))) {
245 if(raw) {
246 Rbyte *pans;
247 size = GlobalSize(hglb);
248 ans = allocVector(RAWSXP, size); /* no R allocation below */
249 pans = RAW(ans);
250 for (j = 0; j < size; j++) pans[j] = *pc++;
251 } else if (format == CF_UNICODETEXT) {
252 int n, ienc = CE_NATIVE;
253 const wchar_t *wpc = (wchar_t *) pc;
254 n = wcslen(wpc);
255 char text[4*n+1];
256 R_CheckStack();
257 wcstoutf8(text, wpc, sizeof(text));
258 if(!strIsASCII(text)) ienc = CE_UTF8;
259 ans = splitClipboardText(text, ienc);
260 } else if (format == CF_TEXT || format == CF_OEMTEXT || format == CF_DIF) {
261 /* can we get the encoding out of a CF_LOCALE entry? */
262 ans = splitClipboardText(pc, 0);
263 } else
264 error("'raw = FALSE' and format is a not a known text format");
265 GlobalUnlock(hglb);
266 }
267 CloseClipboard();
268 }
269 return ans;
270 }
271
writeClipboard(SEXP text,SEXP sformat)272 SEXP writeClipboard(SEXP text, SEXP sformat)
273 {
274 int i, n, format;
275 HGLOBAL hglb;
276 char *s;
277 const char *p;
278 Rboolean success = FALSE, raw = FALSE;
279 const void *vmax = vmaxget();
280
281 format = asInteger(sformat);
282
283 if (TYPEOF(text) == RAWSXP) raw = TRUE;
284 else if(!isString(text))
285 error(_("argument must be a character vector or a raw vector"));
286
287 n = length(text);
288 if(n > 0) {
289 int len = 1;
290 if(raw) len = n;
291 else if (format == CF_UNICODETEXT)
292 for(i = 0; i < n; i++)
293 len += 2 * (wcslen(wtransChar(STRING_ELT(text, i))) + 2);
294 else if (format == CF_TEXT || format == CF_OEMTEXT || format == CF_DIF)
295 for(i = 0; i < n; i++)
296 len += strlen(translateChar(STRING_ELT(text, i))) + 2;
297 else
298 error("'raw = FALSE' and format is a not a known text format");
299
300 if ( (hglb = GlobalAlloc(GHND, len)) &&
301 (s = (char *)GlobalLock(hglb)) ) {
302 if(raw)
303 for(i = 0; i < n; i++) *s++ = RAW(text)[i];
304 else if (format == CF_UNICODETEXT) {
305 const wchar_t *wp;
306 wchar_t *ws = (wchar_t *) s;
307 for(i = 0; i < n; i++) {
308 wp = wtransChar(STRING_ELT(text, i));
309 while(*wp) *ws++ = *wp++;
310 *ws++ = L'\r'; *ws++ = L'\n';
311 }
312 *ws = L'\0';
313 } else {
314 for(i = 0; i < n; i++) {
315 p = translateChar(STRING_ELT(text, i));
316 while(*p) *s++ = *p++;
317 *s++ = '\r'; *s++ = '\n';
318 }
319 *s = '\0';
320 }
321
322 GlobalUnlock(hglb);
323 if (!OpenClipboard(NULL) || !EmptyClipboard()) {
324 warning(_("unable to open the clipboard"));
325 GlobalFree(hglb);
326 } else {
327 success = SetClipboardData(format, hglb) != 0;
328 if(!success) {
329 warning(_("unable to write to the clipboard"));
330 GlobalFree(hglb);
331 }
332 CloseClipboard();
333 }
334 }
335 }
336 vmaxset(vmax);
337 return ScalarLogical(success);
338 }
339
340 #include "Startup.h"
341
342 #include <graphapp/ga.h>
343 #include "rui.h"
344
getIdentification(void)345 SEXP getIdentification(void)
346 {
347 const char *res = "" /* -Wall */;
348
349 switch(CharacterMode) {
350 case RGui:
351 if(RguiMDI & RW_MDI) res = "RGui"; else res = "R Console";
352 break;
353 case RTerm:
354 res = "Rterm";
355 break;
356 default:
357 /* do nothing */
358 break; /* -Wall */
359 }
360 return mkString(res);
361 }
362
getWindowTitle(void)363 SEXP getWindowTitle(void)
364 {
365 char buf[512], *res = "";
366
367 switch(CharacterMode) {
368 case RGui:
369 if(RguiMDI & RW_MDI) res = GA_gettext(RFrame);
370 else res = GA_gettext(RConsole);
371 break;
372 case RTerm:
373 GetConsoleTitle(buf, 512);
374 buf[511] = '\0';
375 res = buf;
376 break;
377 default:
378 /* do nothing */
379 break;
380 }
381 return mkString(res);
382 }
383
384
in_setTitle(const char * title)385 static SEXP in_setTitle(const char *title)
386 {
387 SEXP result = getWindowTitle();
388
389 switch(CharacterMode) {
390 case RGui:
391 if(RguiMDI & RW_MDI) settext(RFrame, title);
392 else settext(RConsole, title);
393 break;
394 case RTerm:
395 SetConsoleTitle(title);
396 break;
397 default:
398 /* do nothing */
399 break; /* -Wall */
400 }
401 return result;
402 }
403
setWindowTitle(SEXP title)404 SEXP setWindowTitle(SEXP title)
405 {
406 if(!isString(title) || LENGTH(title) != 1 ||
407 STRING_ELT(title, 0) == NA_STRING)
408 error(_("'title' must be a character string"));
409 return in_setTitle(translateChar(STRING_ELT(title, 0)));
410 }
411
412
setStatusBar(SEXP text)413 SEXP setStatusBar(SEXP text)
414 {
415 if(!isString(text) || LENGTH(text) != 1 ||
416 STRING_ELT(text, 0) == NA_STRING)
417 error(_("'text' must be a character string"));
418 showstatusbar();
419 setstatus(translateChar(STRING_ELT(text, 0)));
420 return R_NilValue;
421 }
422
getConsoleHandle(const char * which)423 static void * getConsoleHandle(const char *which)
424 {
425 if (CharacterMode != RGui) return(NULL);
426 else if (strcmp(which, "Console") == 0 && RConsole)
427 return getHandle(RConsole);
428 else if (strcmp(which, "Frame") == 0 && RFrame)
429 return getHandle(RFrame);
430 else if (strcmp(which, "Process") == 0)
431 return GetCurrentProcess();
432 else return NULL;
433 }
434
435 #include <R_ext/GraphicsEngine.h>
436 #include "devWindows.h"
getDeviceHandle(int dev)437 static void *getDeviceHandle(int dev)
438 {
439 pGEDevDesc gdd;
440 gadesc *xd;
441
442 if (dev == -1) return(getHandle(RConsole));
443 if (dev < 1 || dev > R_MaxDevices || dev == NA_INTEGER) return(0);
444 gdd = GEgetDevice(dev - 1);
445 if (!gdd) return(NULL);
446 xd = (gadesc *) gdd->dev->deviceSpecific;
447 if (!xd) return(NULL);
448 return getHandle(xd->gawin);
449 }
450
451
getWindowsHandle(SEXP which)452 SEXP getWindowsHandle(SEXP which)
453 {
454 void * handle;
455
456 if(length(which) != 1) error(_("'%s' must be length 1"), "which");
457 if (isString(which)) handle = getConsoleHandle(CHAR(STRING_ELT(which,0)));
458 else if (isInteger(which)) handle = getDeviceHandle(INTEGER(which)[0]);
459 else handle = NULL;
460
461 if (handle)
462 return R_MakeExternalPtr(handle,R_NilValue,R_NilValue);
463 else
464 return R_NilValue;
465 }
466
467 static SEXP EnumResult;
468 static int EnumCount;
469 static PROTECT_INDEX EnumIndex;
470 static int EnumMinimized;
471 static DWORD EnumProcessId;
472
EnumWindowsProc(HWND handle,LPARAM param)473 static BOOL CALLBACK EnumWindowsProc(HWND handle, LPARAM param)
474 {
475 char title[1024];
476 if (IsWindowVisible(handle)) {
477 if (EnumProcessId) { /* restrict to R windows only */
478 DWORD processId;
479 GetWindowThreadProcessId(handle, &processId);
480 if (processId != EnumProcessId) return TRUE;
481 }
482 if (!EnumMinimized && IsIconic(handle)) return TRUE;
483 if (EnumCount >= length(EnumResult)) {
484 int newlen = 2*length(EnumResult);
485 REPROTECT(EnumResult = lengthgets(EnumResult, newlen), EnumIndex);
486 setAttrib(EnumResult, R_NamesSymbol,
487 lengthgets(getAttrib(EnumResult, R_NamesSymbol), newlen));
488 }
489 SET_VECTOR_ELT(EnumResult, EnumCount, R_MakeExternalPtr(handle,R_NilValue,R_NilValue));
490 if (GetWindowText(handle, title, 1024))
491 SET_STRING_ELT(getAttrib(EnumResult, R_NamesSymbol), EnumCount, mkChar(title));
492 EnumCount++;
493 }
494 return TRUE;
495 }
496
getWindowsHandles(SEXP which,SEXP minimized)497 SEXP getWindowsHandles(SEXP which, SEXP minimized)
498 {
499 PROTECT_WITH_INDEX(EnumResult = allocVector(VECSXP, 8), &EnumIndex);
500 setAttrib(EnumResult, R_NamesSymbol, allocVector(STRSXP, 8));
501 EnumCount = 0;
502 const char * w;
503
504 w = CHAR(STRING_ELT(which, 0));
505 EnumMinimized = asLogical(minimized);
506
507 if (strcmp(w, "R") == 0) EnumProcessId = GetCurrentProcessId();
508 else EnumProcessId = 0;
509
510 if (ismdi() && EnumProcessId)
511 EnumChildWindows(GetParent(getHandle(RConsole)), EnumWindowsProc, 0);
512 else
513 EnumWindows(EnumWindowsProc, 0);
514
515 EnumResult = lengthgets(EnumResult, EnumCount);
516 UNPROTECT(1);
517 return EnumResult;
518 }
519
520 static void
in_ArrangeWindows(int n,void ** windows,int action,int preserve,int outer)521 in_ArrangeWindows(int n, void** windows, int action, int preserve, int outer)
522 {
523 int j;
524 if (action == MINIMIZE || action == RESTORE) {
525 for (j=0; j<n; j++)
526 ShowWindow((HWND)windows[j], action == MINIMIZE ? SW_MINIMIZE : SW_RESTORE);
527 } else {
528 RECT rect = {0,0,0,0};
529 RECT *prect = ▭
530 HWND parent;
531 if (preserve) {
532 WINDOWPLACEMENT wp;
533 wp.length = sizeof(wp);
534 for (j=0; j<n; j++) {
535 if (GetWindowPlacement((HWND)windows[j], &wp)) {
536 UnionRect(prect, prect, &wp.rcNormalPosition);
537 if (wp.showCmd == SW_SHOWMINIMIZED || wp.showCmd == SW_SHOWMAXIMIZED) {
538 wp.showCmd = SW_RESTORE;
539 SetWindowPlacement((HWND)windows[j], &wp);
540 }
541 }
542 }
543 }
544 if (rect.left == rect.right || rect.top == rect.bottom) prect = NULL;
545
546 if (!outer && ismdi())
547 parent = GetParent(getHandle(RConsole));
548 else
549 parent = NULL;
550 switch (action) {
551 case CASCADE: CascadeWindows(parent, 0, prect, n, (HWND FAR *)windows);
552 break;
553 case TILEHORIZ: TileWindows(parent, MDITILE_HORIZONTAL, prect, n, (HWND FAR *)windows);
554 break;
555 case TILEVERT: TileWindows(parent, MDITILE_VERTICAL, prect, n, (HWND FAR *)windows);
556 break;
557 }
558 }
559 }
560
arrangeWindows(SEXP call,SEXP op,SEXP args,SEXP env)561 SEXP arrangeWindows(SEXP call, SEXP op, SEXP args, SEXP env)
562 {
563 SEXP windows;
564 int action, preserve, outer;
565
566 args = CDR(args);
567 windows = CAR(args);
568 if (length(windows)) {
569 if (TYPEOF(windows) != VECSXP) error(_("'%s' must be a list"), "windows");
570 void **handles = (void **) R_alloc(length(windows), sizeof(void *));
571 for (int i = 0; i < length(windows); i++) {
572 if (TYPEOF(VECTOR_ELT(windows, i)) != EXTPTRSXP)
573 error(_("'%s' element %d is not a window handle"), "windows", i+1);
574 handles[i] = R_ExternalPtrAddr(VECTOR_ELT(windows, i));
575 }
576 action = asInteger(CADR(args));
577 preserve = asInteger(CADDR(args));
578 outer = asInteger(CADDDR(args));
579 in_ArrangeWindows(length(windows), handles, action, preserve, outer);
580 }
581 return windows;
582 }
583