The R Project SVN R

Rev

Rev 83598 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
15268 ripley 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
3 
 *  file shext.c
4 
 *  Copyright (C) 2001  Guido Masarotto and Brian Ripley
83755 kalibera 5 
 *                2004-2023  R Core Team
15268 ripley 6 
 *
7 
 *  This program is free software; you can redistribute it and/or modify
8 
 *  it under the terms of the GNU General Public License as published by
9 
 *  the Free Software Foundation; either version 2 of the License, or
10 
 *  (at your option) any later version.
11 
 *
12 
 *  This program is distributed in the hope that it will be useful,
13 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
14 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 
 *  GNU General Public License for more details.
16 
 *
17 
 *  You should have received a copy of the GNU General Public License
42300 ripley 18 
 *  along with this program; if not, a copy is available at
68956 ripley 19 
 *  https://www.R-project.org/Licenses/
15268 ripley 20 
 */
21 
 
36901 ripley 22 
#define WIN32_LEAN_AND_MEAN 1
23715 murdoch 23 
#include <windows.h>
15268 ripley 24 
#include <shlobj.h>
83755 kalibera 25 
#include <knownfolders.h>
26 
#include <stdlib.h>
15268 ripley 27 
 
83755 kalibera 28 
static char *ShellGetPersonalDirectory(void)
23715 murdoch 29 
{
83755 kalibera 30 
    wchar_t *wpath;
31 
    char *result = NULL;
29159 murdoch 32 
 
83755 kalibera 33 
    /* CSIDL_PERSONAL */
34 
    if (SHGetKnownFolderPath(&FOLDERID_Documents, KF_FLAG_CREATE, NULL,
35 
                             &wpath) == S_OK) {
36 
	size_t needed = wcstombs(NULL, wpath, 0);
37 
	if (needed != (size_t)-1) {
38 
	    result = (char *)malloc(needed + 1);
39 
	    if (result)
40 
		/* NOTE: some characters may not be representable */
41 
		wcstombs(result, wpath, needed + 1);
29159 murdoch 42 
	}
43 
    }
83755 kalibera 44 
    CoTaskMemFree(wpath);
45 
    return result;
29159 murdoch 46 
}
31849 ripley 47 
 
48 
#include <winbase.h>
49 
extern void R_Suicide(char *s);
50 
 
83755 kalibera 51 
/* Returns a result to be freed by freeRUser(). Previously, pointer to a static
52 
   fixed-size buffer has been returned, so older embedding applications would
53 
   not know to free the result, but they would probably call this function only
54 
   once. */
55 
char *getRUser(void)
31849 ripley 56 
{
45070 ripley 57 
    /*
58 
     * try R_USER then HOME then Windows homes then working directory
59 
     */
31849 ripley 60 
    char *p, *q;
83755 kalibera 61 
    char *RUser = NULL;
31849 ripley 62 
 
83755 kalibera 63 
    if ((p = getenv("R_USER")) || (p = getenv("HOME"))) {
64 
	RUser = (char *)malloc(strlen(p) + 1);
65 
	if (RUser)
66 
	    strcpy(RUser, p);
67 
    } else if ((RUser = ShellGetPersonalDirectory())) {
31849 ripley 68 
	/* nothing to do */;
69 
    } else if ((p = getenv("HOMEDRIVE")) && (q = getenv("HOMEPATH"))) {
83755 kalibera 70 
	RUser = (char *)malloc(strlen(p) + strlen(q) + 1);
31849 ripley 71 
	strcpy(RUser, p);
72 
	strcat(RUser, q);
73 
    } else {
83755 kalibera 74 
	DWORD res = GetCurrentDirectory(0, NULL);
75 
	if (res) {
76 
	    RUser = (char *)malloc(res);
77 
	    if (!GetCurrentDirectory(res, RUser)) {
78 
		free(RUser);
79 
		RUser = NULL;
80 
	    }
81 
	}
31849 ripley 82 
    }
83755 kalibera 83 
    if (!RUser)
84 
	R_Suicide("Cannot determine R user directory");
85 
 
31849 ripley 86 
    p = RUser + (strlen(RUser) - 1);
83598 kalibera 87 
    /* remove trailing file separator(s), unless root directory on a drive */
88 
    while (p > RUser && (*p == '/' || *p == '\\')
89 
           && (p > RUser+2 || *(p-1) != ':'))  *p-- = '\0';
31849 ripley 90 
    return RUser;
91 
}
83755 kalibera 92 
 
93 
void freeRUser(char *s)
94 
{
95 
    free(s);
96 
}
97