/* utils::shortPathName */
SEXP in_shortpath(SEXP paths)
{
SEXP ans, el;
int i, n = LENGTH(paths);
char tmp[MAX_PATH];
wchar_t wtmp[32768];
DWORD res;
const void *vmax = vmaxget();
if(!isString(paths)) error(_("'path' must be a character vector"));
PROTECT(ans = allocVector(STRSXP, n));
for (i = 0; i < n; i++) {
el = STRING_ELT(paths, i);
if(getCharCE(el) == CE_UTF8) {
res = GetShortPathNameW(filenameToWchar(el, FALSE), wtmp, 32768);
if (res && res <= 32768)
wcstoutf8(tmp, wtmp, wcslen(wtmp)+1);
else
strcpy(tmp, translateChar(el));
/* documented to return paths using \, which the API call does
not necessarily do */
R_fixbackslash(tmp);
SET_STRING_ELT(ans, i, mkCharCE(tmp, CE_UTF8));
} else {
res = GetShortPathName(translateChar(el), tmp, MAX_PATH);
if (res == 0 || res > MAX_PATH) strcpy(tmp, translateChar(el));
/* documented to return paths using \, which the API call does
not necessarily do */
R_fixbackslash(tmp);
SET_STRING_ELT(ans, i, mkChar(tmp));
}
}
UNPROTECT(1);
vmaxset(vmax);
return ans;
}
static void load(button b) /* button callback */
{
char *optf, buf[256];
struct structGUI newGUI;
setuserfilter("All files (*.*)\0*.*\0\0");
strcpy(buf, getenv("R_USER"));
R_fixbackslash(buf);
optf = askfilenamewithdir(G_("Select 'Rconsole' file"), "Rconsole", buf);
if(!optf) return;
getChoices(&newGUI);
if (loadRconsole(&newGUI, optf)) {
if (strlen(newGUI.warning)) askok(newGUI.warning);
cleanup();
showDialog(&newGUI);
}
}
SEXP chooseDir(SEXP def, SEXP caption)
{
const char *p;
char path[MAX_PATH];
if(!isString(def) || length(def) != 1 )
error(_("'default' must be a character string"));
p = translateChar(STRING_ELT(def, 0));
if(strlen(p) >= MAX_PATH) error(_("'default' is overlong"));
strcpy(path, R_ExpandFileName(p));
R_fixbackslash(path);
if(!isString(caption) || length(caption) != 1 )
error(_("'caption' must be a character string"));
p = askcdstring(translateChar(STRING_ELT(caption, 0)), path);
SEXP ans = PROTECT(allocVector(STRSXP, 1));
SET_STRING_ELT(ans, 0, p ? mkChar(p): NA_STRING);
UNPROTECT(1);
return ans;
}
static void save(button b)
{
char *file, buf[256], *p;
FILE *fp;
setuserfilter("All files (*.*)\0*.*\0\0");
strcpy(buf, getenv("R_USER"));
R_fixbackslash(buf);
file = askfilesavewithdir(G_("Select directory for file 'Rconsole'"),
"Rconsole", buf);
if(!file) return;
strcpy(buf, file);
p = buf + strlen(buf) - 2;
if(!strncmp(p, ".*", 2)) *p = '\0';
fp = R_fopen(buf, "w");
if(fp == NULL) {
MessageBox(0, "Cannot open file to fp",
"Configuration Save Error",
MB_TASKMODAL | MB_ICONSTOP | MB_OK);
return;
}
fprintf(fp, "%s\n%s\n%s\n\n%s\n%s\n",
"# Optional parameters for the console and the pager",
"# The system-wide copy is in rwxxxx/etc.",
"# A user copy can be installed in `R_USER'.",
"## Style",
"# This can be `yes' (for MDI) or `no' (for SDI).");
fprintf(fp, "MDI = %s\n", ischecked(rb_mdi)?"yes":"no");
fprintf(fp, "%s\n%s%s\n%s%s\n\n",
"# the next two are only relevant for MDI",
"toolbar = ", ischecked(toolbar)?"yes":"no",
"statusbar = ", ischecked(statusbar)?"yes":"no");
fprintf(fp, "%s\n%s\n%s\n%s\n%s\n",
"## Font.",
"# Please use only fixed width font.",
"# If font=FixedFont the system fixed font is used; in this case",
"# points and style are ignored. If font begins with \"TT \", only",
"# True Type fonts are searched for.");
fprintf(fp, "font = %s%s\npoints = %s\nstyle = %s # Style can be normal, bold, italic\n\n\n",
ischecked(tt_font)?"TT ":"",
gettext(f_font),
gettext(d_point),
gettext(f_style));
fprintf(fp, "# Dimensions (in characters) of the console.\n");
fprintf(fp, "rows = %s\ncolumns = %s\n",
gettext(f_crows), gettext(f_ccols));
fprintf(fp, "# Dimensions (in characters) of the internal pager.\n");
fprintf(fp, "pgrows = %s\npgcolumns = %s\n",
gettext(f_prows), gettext(f_pcols));
fprintf(fp, "# should options(width=) be set to the console width?\n");
fprintf(fp, "setwidthonresize = %s\n\n",
ischecked(c_resize) ? "yes" : "no");
fprintf(fp, "# memory limits for the console scrolling buffer, in chars and lines\n");
fprintf(fp, "bufbytes = %s\nbuflines = %s\n\n",
gettext(f_cbb), gettext(f_cbl));
fprintf(fp, "# Initial position of the console (pixels, relative to the workspace for MDI)\n");
fprintf(fp, "xconsole = %s\nyconsole = %s\n\n",
gettext(f_cx), gettext(f_cy));
fprintf(fp, "%s\n%s\n%s\n%s\n%s\n%s\n\n",
"# Dimension of MDI frame in pixels",
"# Format (w*h+xorg+yorg) or use -ve w and h for offsets from right bottom",
"# This will come up maximized if w==0",
"# MDIsize = 0*0+0+0",
"# MDIsize = 1000*800+100+0",
"# MDIsize = -50*-50+50+50 # 50 pixels space all round");
fprintf(fp, "%s\n%s\n%s\npagerstyle = %s\n\n\n",
"# The internal pager can displays help in a single window",
"# or in multiple windows (one for each topic)",
"# pagerstyle can be set to `singlewindow' or `multiplewindows'",
ischecked(rb_mwin) ? "multiplewindows" : "singlewindow");
fprintf(fp, "## Colours for console and pager(s)\n# (see rwxxxx/etc/rgb.txt for the known colours).\n");
for (int i=0; i<numGuiColors; i++)
fprintf(fp, "%s = %s\n", GuiElementNames[i], rgbtoname(dialogColors[i]));
fprintf(fp, "\n\n%s\n%s\nxgraphics = %s\nygraphics = %s\n",
"## Initial position of the graphics window",
"## (pixels, <0 values from opposite edge)",
gettext(f_grx), gettext(f_gry));
fprintf(fp, "\n\n%s\nlanguage = %s\n",
"## Language for messages",
gettext(f_lang));
fprintf(fp, "\n\n## Default setting for console buffering: 'yes' or 'no'\n");
fprintf(fp, "buffered = %s\n",
ischecked(c_buff) ? "yes" : "no");
fprintf(fp, "\n\n%s\ncursor_blink = %s\n",
"## Console cursor blink",
BlinkList[getlistitem(f_blink)]);
fclose(fp);
}