The R Project SVN – R – Diff – /branches/R-exp-API/src/gnuwin32/extra.c



#include <windows.h>
#include "graphapp/ga.h"
 
static char DefaultFileName[MAX_PATH];
 
/*
 * replacement for Windows function that uses root directory
 */
char * tmpnam(char * str)
{
    char *tmp, tmp1[MAX_PATH], *tmp2, *p;

    if(str) tmp2 = str; else tmp2 = DefaultFileName;
    tmp = getenv("TMP");
    if (!tmp) tmp = getenv("TEMP");
    if (!tmp) tmp = getenv("R_USER"); /* this one will succeed */
    /* make sure no spaces in path */
    for (p = tmp; *p; p++)
	if (isspace(*p)) { hasspace = 1; break; }
    if (hasspace)
	GetShortPathName(tmp, tmp1, MAX_PATH);
    else
	strcpy(tmp1, tmp);

    /* try to get a new file name */
    tmp = getenv("TMP");
    if (!tmp) tmp = getenv("TEMP");
    if (!tmp) tmp = getenv("R_USER"); /* this one will succeed */
    /* make sure no spaces in path */
    for (p = tmp; *p; p++)
	if (isspace(*p)) { hasspace = 1; break; }
    if (hasspace)
	GetShortPathName(tmp, tmp1, MAX_PATH);
    else
	strcpy(tmp1, tmp);

    FILE *ff;
 
    checkArity(op, args);
    home = getenv("R_HOME");
    if (home == NULL)
	error("R_HOME not set");
    sprintf(buf, "%s\\doc\\html\\index.html", home);
    ff = fopen(buf, "r");
    if (!ff) {
	sprintf(buf, "%s\\doc\\html\\index.htm", home);
	ff = fopen(buf, "r");

	    error(buf);
	}
	fclose(ff);
	home = getenv("R_HOME");
	if (home == NULL)
	    error("R_HOME not set");
	ShellExecute(NULL, "open", item, NULL, home, SW_SHOW);
    } else if (type == 2) {
	if (!isString(CADDR(args)))
	    errorcall(call, "invalid hlpfile argument");
	hfile = CHAR(STRING(CADDR(args))[0]);

    R_FlushConsole();
    return R_NilValue;
}
 
#include <winbase.h>
/* typedef struct _OSVERSIONINFO{
    DWORD dwOSVersionInfoSize;
    DWORD dwMajorVersion;
    DWORD dwMinorVersion;
    DWORD dwBuildNumber;
    DWORD dwPlatformId;
    TCHAR szCSDVersion[ 128 ];
    } OSVERSIONINFO; */
 
 
SEXP do_winver(SEXP call, SEXP op, SEXP args, SEXP env)
{
    char isNT[8]="??", ver[256];
    SEXP ans;
    OSVERSIONINFO verinfo;
 
    checkArity(op, args);
    verinfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
    GetVersionEx(&verinfo);
    switch(verinfo.dwPlatformId) {
    case VER_PLATFORM_WIN32_NT:

    case VER_PLATFORM_WIN32_WINDOWS:
	strcpy(isNT, "9x");
	break;
    case VER_PLATFORM_WIN32s:
	strcpy(isNT, "win32s");
	break;
    default:
	sprintf(isNT, "ID=%d", (int)verinfo.dwPlatformId);
	break;
    }
 
    sprintf(ver, "Windows %s %d.%d (build %d) %s", isNT,
	    (int)verinfo.dwMajorVersion, (int)verinfo.dwMinorVersion,
	    LOWORD(verinfo.dwBuildNumber), verinfo.szCSDVersion);
 
    PROTECT(ans = allocVector(STRSXP, 1));
    STRING(ans)[0] = mkChar(ver);
    UNPROTECT(1);
    return (ans);
}

Rev 6180	Rev 6192
Line 33...	Line 33...
33	`#include <windows.h>`	33	`#include <windows.h>`
34	`#include "graphapp/ga.h"`	34	`#include "graphapp/ga.h"`
35		35
36	`static char DefaultFileName[MAX_PATH];`	36	`static char DefaultFileName[MAX_PATH];`
37		37
38	`/*`	38	`/*`
39	`* replacement for Windows function that uses root directory`	39	`* replacement for Windows function that uses root directory`
40	`*/`	40	`*/`
41	`char * tmpnam(char * str)`	41	`char * tmpnam(char * str)`
42	`{`	42	`{`
43	`char tmp, tmp1[MAX_PATH], tmp2, *p;`	43	`char tmp, tmp1[MAX_PATH], tmp2, *p;`
Line 46...	Line 46...
46	`if(str) tmp2 = str; else tmp2 = DefaultFileName;`	46	`if(str) tmp2 = str; else tmp2 = DefaultFileName;`
47	`tmp = getenv("TMP");`	47	`tmp = getenv("TMP");`
48	`if (!tmp) tmp = getenv("TEMP");`	48	`if (!tmp) tmp = getenv("TEMP");`
49	`if (!tmp) tmp = getenv("R_USER"); /* this one will succeed */`	49	`if (!tmp) tmp = getenv("R_USER"); /* this one will succeed */`
50	`/* make sure no spaces in path */`	50	`/* make sure no spaces in path */`
51	`for (p = tmp; *p; p++)`	51	`for (p = tmp; *p; p++)`
52	`if (isspace(*p)) { hasspace = 1; break; }`	52	`if (isspace(*p)) { hasspace = 1; break; }`
53	`if (hasspace)`	53	`if (hasspace)`
54	`GetShortPathName(tmp, tmp1, MAX_PATH);`	54	`GetShortPathName(tmp, tmp1, MAX_PATH);`
55	`else`	55	`else`
56	`strcpy(tmp1, tmp);`	56	`strcpy(tmp1, tmp);`
Line 76...	Line 76...
76	`/* try to get a new file name */`	76	`/* try to get a new file name */`
77	`tmp = getenv("TMP");`	77	`tmp = getenv("TMP");`
78	`if (!tmp) tmp = getenv("TEMP");`	78	`if (!tmp) tmp = getenv("TEMP");`
79	`if (!tmp) tmp = getenv("R_USER"); /* this one will succeed */`	79	`if (!tmp) tmp = getenv("R_USER"); /* this one will succeed */`
80	`/* make sure no spaces in path */`	80	`/* make sure no spaces in path */`
81	`for (p = tmp; *p; p++)`	81	`for (p = tmp; *p; p++)`
82	`if (isspace(*p)) { hasspace = 1; break; }`	82	`if (isspace(*p)) { hasspace = 1; break; }`
83	`if (hasspace)`	83	`if (hasspace)`
84	`GetShortPathName(tmp, tmp1, MAX_PATH);`	84	`GetShortPathName(tmp, tmp1, MAX_PATH);`
85	`else`	85	`else`
86	`strcpy(tmp1, tmp);`	86	`strcpy(tmp1, tmp);`
Line 159...	Line 159...
159	`FILE *ff;`	159	`FILE *ff;`
160		160
161	`checkArity(op, args);`	161	`checkArity(op, args);`
162	`home = getenv("R_HOME");`	162	`home = getenv("R_HOME");`
163	`if (home == NULL)`	163	`if (home == NULL)`
164	`error("R_HOME not set\n");`	164	`error("R_HOME not set");`
165	`sprintf(buf, "%s\\doc\\html\\index.html", home);`	165	`sprintf(buf, "%s\\doc\\html\\index.html", home);`
166	`ff = fopen(buf, "r");`	166	`ff = fopen(buf, "r");`
167	`if (!ff) {`	167	`if (!ff) {`
168	`sprintf(buf, "%s\\doc\\html\\index.htm", home);`	168	`sprintf(buf, "%s\\doc\\html\\index.htm", home);`
169	`ff = fopen(buf, "r");`	169	`ff = fopen(buf, "r");`
Line 206...	Line 206...
206	`error(buf);`	206	`error(buf);`
207	`}`	207	`}`
208	`fclose(ff);`	208	`fclose(ff);`
209	`home = getenv("R_HOME");`	209	`home = getenv("R_HOME");`
210	`if (home == NULL)`	210	`if (home == NULL)`
211	`error("R_HOME not set\n");`	211	`error("R_HOME not set");`
212	`ShellExecute(NULL, "open", item, NULL, home, SW_SHOW);`	212	`ShellExecute(NULL, "open", item, NULL, home, SW_SHOW);`
213	`} else if (type == 2) {`	213	`} else if (type == 2) {`
214	`if (!isString(CADDR(args)))`	214	`if (!isString(CADDR(args)))`
215	`errorcall(call, "invalid hlpfile argument");`	215	`errorcall(call, "invalid hlpfile argument");`
216	`hfile = CHAR(STRING(CADDR(args))[0]);`	216	`hfile = CHAR(STRING(CADDR(args))[0]);`
Line 247...	Line 247...
247	`R_FlushConsole();`	247	`R_FlushConsole();`
248	`return R_NilValue;`	248	`return R_NilValue;`
249	`}`	249	`}`
250		250
251	`#include <winbase.h>`	251	`#include <winbase.h>`
252	`/* typedef struct _OSVERSIONINFO{`	252	`/* typedef struct _OSVERSIONINFO{`
253	`DWORD dwOSVersionInfoSize;`	253	`DWORD dwOSVersionInfoSize;`
254	`DWORD dwMajorVersion;`	254	`DWORD dwMajorVersion;`
255	`DWORD dwMinorVersion;`	255	`DWORD dwMinorVersion;`
256	`DWORD dwBuildNumber;`	256	`DWORD dwBuildNumber;`
257	`DWORD dwPlatformId;`	257	`DWORD dwPlatformId;`
258	`TCHAR szCSDVersion[ 128 ];`	258	`TCHAR szCSDVersion[ 128 ];`
259	`} OSVERSIONINFO; */`	259	`} OSVERSIONINFO; */`
260		260
261		261
262	`SEXP do_winver(SEXP call, SEXP op, SEXP args, SEXP env)`	262	`SEXP do_winver(SEXP call, SEXP op, SEXP args, SEXP env)`
263	`{`	263	`{`
264	`char isNT[8]="??", ver[256];`	264	`char isNT[8]="??", ver[256];`
265	`SEXP ans;`	265	`SEXP ans;`
266	`OSVERSIONINFO verinfo;`	266	`OSVERSIONINFO verinfo;`
267		267
268	`checkArity(op, args);`	268	`checkArity(op, args);`
269	`verinfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);`	269	`verinfo.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);`
270	`GetVersionEx(&verinfo);`	270	`GetVersionEx(&verinfo);`
271	`switch(verinfo.dwPlatformId) {`	271	`switch(verinfo.dwPlatformId) {`
272	`case VER_PLATFORM_WIN32_NT:`	272	`case VER_PLATFORM_WIN32_NT:`
Line 275...	Line 275...
275	`case VER_PLATFORM_WIN32_WINDOWS:`	275	`case VER_PLATFORM_WIN32_WINDOWS:`
276	`strcpy(isNT, "9x");`	276	`strcpy(isNT, "9x");`
277	`break;`	277	`break;`
278	`case VER_PLATFORM_WIN32s:`	278	`case VER_PLATFORM_WIN32s:`
279	`strcpy(isNT, "win32s");`	279	`strcpy(isNT, "win32s");`
280	`break;`	280	`break;`
281	`default:`	281	`default:`
282	`sprintf(isNT, "ID=%d", (int)verinfo.dwPlatformId);`	282	`sprintf(isNT, "ID=%d", (int)verinfo.dwPlatformId);`
283	`break;`	283	`break;`
284	`}`	284	`}`
285		285
286	`sprintf(ver, "Windows %s %d.%d (build %d) %s", isNT,`	286	`sprintf(ver, "Windows %s %d.%d (build %d) %s", isNT,`
287	`(int)verinfo.dwMajorVersion, (int)verinfo.dwMinorVersion,`	287	`(int)verinfo.dwMajorVersion, (int)verinfo.dwMinorVersion,`
288	`LOWORD(verinfo.dwBuildNumber), verinfo.szCSDVersion);`	288	`LOWORD(verinfo.dwBuildNumber), verinfo.szCSDVersion);`
289		289
290	`PROTECT(ans = allocVector(STRSXP, 1));`	290	`PROTECT(ans = allocVector(STRSXP, 1));`
291	`STRING(ans)[0] = mkChar(ver);`	291	`STRING(ans)[0] = mkChar(ver);`
292	`UNPROTECT(1);`	292	`UNPROTECT(1);`
293	`return (ans);`	293	`return (ans);`
294	`}`	294	`}`

The R Project SVN R

(root)/branches/R-exp-API/src/gnuwin32/extra.c @ 63243 – Rev 6180 → 6192