The R Project SVN R

/* 
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1999-2007 The R Development Core Team
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, a copy is available at
 *  http://www.r-project.org/Licenses/
 */

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#include <Defn.h>

#include "Runix.h"
#include <sys/types.h>
#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif


#if defined(HAVE_AQUA)

#include <Rdevices.h>
#include <R_ext/GraphicsDevice.h> 
 
extern Rboolean useaqua; /* from src/unix/system.c */


DL_FUNC ptr_do_wsbrowser, ptr_GetQuartzParameters, 
    ptr_do_dataentry, ptr_do_browsepkgs, ptr_do_datamanger,
    ptr_do_packagemanger, ptr_do_flushconsole, ptr_do_hsbrowser,
    ptr_do_selectlist;

DL_FUNC ptr_R_ProcessEvents, ptr_CocoaInnerQuartzDevice, 
    ptr_CocoaGetQuartzParameters, ptr_CocoaSystem;

int (*ptr_Raqua_CustomPrint)(char *, SEXP);

DL_FUNC ptr_QuartzDeviceCreate;

/* new general Quartz call */
Rboolean QuartzDeviceCreate(NewDevDesc *dd,const char *type,const char *file,
    double width,double height,double pointsize,const char *family,Rboolean antialias,Rboolean smooth,
    Rboolean autorefresh,int quartzpos, int bg, const char *title, double *dpi)
{
  if(NULL == ptr_QuartzDeviceCreate) return FALSE;
  return (Rboolean)ptr_QuartzDeviceCreate(dd, type, file, width, height,
                      pointsize, family, antialias, smooth, autorefresh,
                      quartzpos, bg, title, dpi);
}

/* obsolete Quartz Cocoa call */
Rboolean CocoaInnerQuartzDevice(NewDevDesc *dd,char *display,
                double width,double height,
                double pointsize,char *family,
                Rboolean antialias,
                Rboolean autorefresh,int quartzpos,
                int bg){
    return (Rboolean)ptr_CocoaInnerQuartzDevice(dd, display,
                        width, height,
                        pointsize, family,
                        antialias,
                        autorefresh, quartzpos,
                        bg);
}

void CocoaGetQuartzParameters(double *width, double *height, double *ps, 
                  char *family, Rboolean *antialias, 
                  Rboolean *autorefresh, int *quartzpos){
    ptr_CocoaGetQuartzParameters(width, height, ps, family, antialias,
                 autorefresh, quartzpos);
}

void R_ProcessEvents(void);

SEXP do_wsbrowser(SEXP call, SEXP op, SEXP args, SEXP env)
{
    return(ptr_do_wsbrowser(call, op, args, env));
}

#if defined(HAVE_X11)
extern SEXP X11_do_dataentry(SEXP call, SEXP op, SEXP args, SEXP rho); /* from src/unix/X11.c */
#endif

SEXP do_dataentry(SEXP call, SEXP op, SEXP args, SEXP env)
{
    if(useaqua)
    return(ptr_do_dataentry(call, op, args, env));
#if defined(HAVE_X11)
    else
    return(X11_do_dataentry(call, op, args, env));  
#endif
}

SEXP do_browsepkgs(SEXP call, SEXP op, SEXP args, SEXP env)
{
    return(ptr_do_browsepkgs(call, op, args, env));
}


SEXP do_datamanger(SEXP call, SEXP op, SEXP args, SEXP env)
{
    return(ptr_do_datamanger(call, op, args, env));
}


SEXP do_hsbrowser(SEXP call, SEXP op, SEXP args, SEXP env)
{
    return(ptr_do_hsbrowser(call, op, args, env));
}

SEXP do_packagemanger(SEXP call, SEXP op, SEXP args, SEXP env)
{
    return(ptr_do_packagemanger(call, op, args, env));
}

SEXP do_flushconsole(SEXP call, SEXP op, SEXP args, SEXP env)
{
    if(ptr_do_flushconsole)
        ptr_do_flushconsole(call, op, args, env);
    return R_NilValue; 
}

SEXP do_selectlist(SEXP call, SEXP op, SEXP args, SEXP env)
{
    return(ptr_do_selectlist(call, op, args, env));
}

SEXP do_aqua_custom_print(SEXP call, SEXP op, SEXP args, SEXP env)
{
    char *vm;
    char *ct;
    int cpr;  
    SEXP rv, objType, obj;

    if (!ptr_Raqua_CustomPrint) return R_NilValue;

    checkArity(op, args);
  
    vm = vmaxget();
  
    objType = CAR(args); args = CDR(args);
    obj = CAR(args);

    if (!isString(objType) || LENGTH(objType)<1)
        errorcall(call, "invalid arguments");
    ct=CHAR(STRING_ELT(objType,0));
    cpr=ptr_Raqua_CustomPrint(ct, obj);

    PROTECT(rv=allocVector(INTSXP, 1));
    INTEGER(rv)[0]=cpr;

    vmaxset(vm);
    UNPROTECT(1);

    return rv;
}

void R_ProcessEvents(void)
{
  if (ptr_R_ProcessEvents)
    ptr_R_ProcessEvents();
  if (R_interrupts_pending)
    onintr();
}
#endif