The R Project SVN R

Rev

Rev 27253 | Rev 28873 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 27253 Rev 28130
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
 2 
 *  R : A Computer Language for Statistical Data Analysis
3 
 *  file extra.c
 3 
 *  file extra.c
4 
 *  Copyright (C) 1998--2003  Guido Masarotto and Brian Ripley
 4 
 *  Copyright (C) 1998--2003  Guido Masarotto and Brian Ripley
- 
 
 5 
 *  Copyright (C) 2004	      The R Foundation
5 
 *
 6 
 *
6 
 *  This program is free software; you can redistribute it and/or modify
 7 
 *  This program is free software; you can redistribute it and/or modify
7 
 *  it under the terms of the GNU General Public License as published by
 8 
 *  it under the terms of the GNU General Public License as published by
8 
 *  the Free Software Foundation; either version 2 of the License, or
 9 
 *  the Free Software Foundation; either version 2 of the License, or
9 
 *  (at your option) any later version.
 10 
 *  (at your option) any later version.
Line 490... Line 491...
490 
 
 491 
 
491 
#include "Startup.h"
 492 
#include "Startup.h"
492 
extern UImode CharacterMode;
 493 
extern UImode CharacterMode;
493 
static char msgbuf[256];
 494 
static char msgbuf[256];
494 
 
 495 
 
- 
 
 496 
SEXP do_winmenunames(SEXP call, SEXP op, SEXP args, SEXP env)
- 
 
 497 
{
- 
 
 498 
    SEXP menuNames;
- 
 
 499 
    int i, nmenus;
- 
 
 500 
 
- 
 
 501 
    checkArity(op, args);
- 
 
 502 
    if (CharacterMode != RGui)
- 
 
 503 
	errorcall(call, "Menu functions can only be used in the GUI");
- 
 
 504 
 
- 
 
 505 
    nmenus = numwinmenus();
- 
 
 506 
 
- 
 
 507 
    PROTECT(menuNames = allocVector(STRSXP, nmenus));
- 
 
 508 
 
- 
 
 509 
    for (i = 0; i < nmenus; i++) {
- 
 
 510 
	SET_STRING_ELT(menuNames, i, mkChar(getusermenuname(i)));
- 
 
 511 
    }
- 
 
 512 
 
- 
 
 513 
    UNPROTECT(1);
- 
 
 514 
    return(menuNames);
- 
 
 515 
}
- 
 
 516 
 
- 
 
 517 
SEXP do_wingetmenuitems(SEXP call, SEXP op, SEXP args, SEXP env)
- 
 
 518 
{
- 
 
 519 
    SEXP mname, ans, ansnames;
- 
 
 520 
    menuItems *items;
- 
 
 521 
    char errmsg[50];
- 
 
 522 
    int i;
- 
 
 523 
 
- 
 
 524 
 
- 
 
 525 
    checkArity(op, args);
- 
 
 526 
    if (CharacterMode != RGui)
- 
 
 527 
	errorcall(call, "Menu functions can only be used in the GUI");
- 
 
 528 
 
- 
 
 529 
    mname = CAR(args);
- 
 
 530 
    if (!isString(mname) || length(mname) != 1)
- 
 
 531 
	error("invalid 'menuname' argument");
- 
 
 532 
 
- 
 
 533 
    items = wingetmenuitems(CHAR(STRING_ELT(mname,0)), errmsg);
- 
 
 534 
    if (items->numItems == 0) {
- 
 
 535 
	sprintf(msgbuf, "unable to retrieve items for %s (%s)",
- 
 
 536 
		CHAR(STRING_ELT(mname,0)), errmsg);
- 
 
 537 
	freemenuitems(items);
- 
 
 538 
	errorcall(call, msgbuf);
- 
 
 539 
    }
- 
 
 540 
 
- 
 
 541 
    PROTECT(ans = allocVector(STRSXP, items->numItems));
- 
 
 542 
    PROTECT(ansnames = allocVector(STRSXP, items->numItems));
- 
 
 543 
    for (i = 0; i < items->numItems; i++) {
- 
 
 544 
	SET_STRING_ELT(ans, i, mkChar(items->mItems[i]->action));
- 
 
 545 
	SET_STRING_ELT(ansnames, i, mkChar(items->mItems[i]->name));
- 
 
 546 
    }
- 
 
 547 
 
- 
 
 548 
    setAttrib(ans, R_NamesSymbol, ansnames);
- 
 
 549 
 
- 
 
 550 
    freemenuitems(items);
- 
 
 551 
 
- 
 
 552 
    UNPROTECT(2);
- 
 
 553 
    return(ans);
- 
 
 554 
}
- 
 
 555 
 
- 
 
 556 
 
495 
SEXP do_winmenuadd(SEXP call, SEXP op, SEXP args, SEXP env)
 557 
SEXP do_winmenuadd(SEXP call, SEXP op, SEXP args, SEXP env)
496 
{
 558 
{
497 
    SEXP smenu, sitem;
 559 
    SEXP smenu, sitem;
498 
    int res;
 560 
    int res;
499 
    char errmsg[50];
 561 
    char errmsg[50];
Line 931... Line 993...
931 
	R_Suicide("cannot find unused tempdir name");
 993 
	R_Suicide("cannot find unused tempdir name");
932 
    /* Now try to create it */
 994 
    /* Now try to create it */
933 
    res = mkdir(tm);
 995 
    res = mkdir(tm);
934 
    if(res) {
 996 
    if(res) {
935 
	char buff[2000];
 997 
	char buff[2000];
936 
	sprintf(buff, "%s\nDoes %s exist and is it writeable?",
998 
	sprintf(buff, "%s\nDoes %s exist and is it writeable?",
937 
		"Can't mkdir R_TempDir", tmp);
 999 
		"Can't mkdir R_TempDir", tmp);
938 
	R_Suicide(buff);
 1000 
	R_Suicide(buff);
939 
    }
 1001 
    }
940 
    len = strlen(tm);
 1002 
    len = strlen(tm);
941 
    p = (char *) malloc(len+1);
 1003 
    p = (char *) malloc(len+1);