← Back to branch summary

~showard314/ubuntu/karmic/r-base/remove_start_comments

« back to all changes in this revision

Viewing changes to src/modules/X11/dataentry.c

  • Committer: Bazaar Package Importer
  • Author(s): Dirk Eddelbuettel
  • Date: 2009-01-19 12:40:24 UTC
  • mfrom: (5.1.4 sid)
  • Revision ID: james.westby@ubuntu.com-20090119124024-abxsf4e0y7713w9m
Tags: 2.8.1-2
http://bugs.debian.org/512324
debian/control: Add another Build-Depends: exclusion for the 
'kfreebsd-i386 kfreebsd-amd64 hurd-i386' architecture to openjdk-6-jdk.
Thanks to Petr Salinger for the heads-up.               (Closes: 512324)

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/modules/X11/dataentry.c
38
38
 
39
39
#include <Defn.h>
40
40
#include <stdlib.h>
 
41
#include <Rinternals.h>
 
42
#include <R_ext/Parse.h>  /* parsing is used in handling escape codes */
 
43
 
41
44
 
42
45
#ifndef _Xconst
43
46
#define _Xconst const
195
198
/* The next few and used only for the editor in MBCS locales */
196
199
#ifdef USE_FONTSET
197
200
static Status           status;
198
 
static XFontSet         font_set;
 
201
static XFontSet         font_set = NULL;
199
202
static XFontStruct      **fs_list;
200
203
static int              font_set_cnt;
201
204
static char             fontset_name[]="-*-fixed-medium-r-*-*-*-120-*-*-*-*-*-*";
222
225
    XIMStatusNone,
223
226
    (XIMStyle)NULL,
224
227
};
225
 
static XIC ioic;
 
228
static XIC ioic = NULL;
226
229
#endif
227
230
 
228
231
#ifndef max
397
400
    endcontext(&cntxt);
398
401
    closewin(DE);
399
402
    if(nView == 0) {
 
403
        if(fdView >= 0) { /* might be open after viewers, but unlikely */
 
404
            removeInputHandler(&R_InputHandlers,
 
405
                               getInputHandler(R_InputHandlers,fdView));
 
406
            fdView = -1;
 
407
        }
 
408
#ifdef USE_FONTSET
 
409
        if(font_set) {
 
410
            XFreeFontSet(iodisplay, font_set);
 
411
            font_set = NULL;
 
412
        }
 
413
#endif
400
414
        XCloseDisplay(iodisplay);
401
415
        iodisplay = NULL;
402
416
    }
1043
1057
    return newcol;
1044
1058
}
1045
1059
 
 
1060
static SEXP lang5(SEXP s, SEXP t, SEXP u, SEXP v, SEXP w)
 
1061
{
 
1062
    PROTECT(s);
 
1063
    s = LCONS(s, list4(t, u, v, w));
 
1064
    UNPROTECT(1);
 
1065
    return s;
 
1066
}
 
1067
 
 
1068
static SEXP processEscapes(SEXP x)
 
1069
{
 
1070
    SEXP newval, pattern, replacement, expr;
 
1071
    ParseStatus status;
 
1072
    
 
1073
    /* We process escape sequences in a scalar string by escaping
 
1074
       unescaped quotes, then quoting the whole thing and parsing it.  This
 
1075
       is supposed to be equivalent to the R code
 
1076
 
 
1077
       newval <- gsub(perl=TRUE, "(?<!\\\\)((\\\\\\\\)*)\"", "\\1\\\\\"", x)
 
1078
       newval <- sub('(^.*$)', '"\1"', newval)
 
1079
       newval <- eval(parse(text=newval))
 
1080
 
 
1081
       We do it this way to avoid extracting the escape handling
 
1082
       code from the parser.  We need it in C code because this may be executed
 
1083
       numerous times from C in dataentry.c */
 
1084
        
 
1085
    PROTECT( pattern = mkString("(?<!\\\\)((\\\\\\\\)*)\"") );
 
1086
    PROTECT( replacement = mkString("\\1\\\\\"") );
 
1087
    PROTECT( expr = lang5(install("gsub"), ScalarLogical(1), pattern, replacement, x) );
 
1088
    SET_TAG( CDR(expr), install("perl") );
 
1089
 
 
1090
    PROTECT( newval = eval(expr, R_BaseEnv) );
 
1091
    PROTECT( pattern = mkString("(^.*$)") );
 
1092
    PROTECT( replacement = mkString("\"\\1\"") );
 
1093
    PROTECT( expr = lang4(install("sub"), pattern, replacement, newval) );
 
1094
    PROTECT( newval = eval(expr, R_BaseEnv) );
 
1095
    PROTECT( expr = R_ParseVector( newval, 1, &status, R_NilValue) );
 
1096
    
 
1097
    /* We only handle the first entry. If this were available more generally,
 
1098
       we'd probably want to loop over all of expr */
 
1099
       
 
1100
    if (status == PARSE_OK && length(expr))
 
1101
        PROTECT( newval = eval(VECTOR_ELT(expr, 0), R_BaseEnv) );
 
1102
    else
 
1103
        PROTECT( newval = R_NilValue );  /* protect just so the count doesn't change */
 
1104
    UNPROTECT(10);
 
1105
    return newval;
 
1106
}
 
1107
 
1046
1108
/* close up the entry to a cell, put the value that has been entered
1047
1109
   into the correct place and as the correct type */
1048
1110
 
1090
1152
                char *endp;
1091
1153
                double new = R_strtod(buf, &endp);
1092
1154
                Rboolean warn = !isBlankString(endp);
1093
 
                if (TYPEOF(cvec) == STRSXP)
1094
 
                    SET_STRING_ELT(cvec, wrow - 1, mkChar(buf));
1095
 
                else
 
1155
                if (TYPEOF(cvec) == STRSXP) {
 
1156
                    SEXP newval;
 
1157
                    PROTECT( newval = mkString(buf) );
 
1158
                    PROTECT( newval = processEscapes(newval) );
 
1159
                    if (TYPEOF(newval) == STRSXP && length(newval) == 1)
 
1160
                        SET_STRING_ELT(cvec, wrow - 1, STRING_ELT(newval, 0));
 
1161
                    else
 
1162
                        warning("dataentry: parse error on string");
 
1163
                    UNPROTECT(2);
 
1164
                } else
1096
1165
                    REAL(cvec)[wrow - 1] = new;
1097
1166
                if (newcol && warn) {
1098
1167
                    /* change mode to character */
1490
1559
{
1491
1560
    int done;
1492
1561
    DEEvent ioevent;
 
1562
    caddr_t temp;
1493
1563
 
1494
1564
    done = 0;
1495
1565
    while (done == 0) {
1496
1566
        XNextEvent(iodisplay, &ioevent);
1497
 
        {
 
1567
        XFindContext(iodisplay, ioevent.xany.window, deContext, &temp);
 
1568
        if ((DEstruct) temp != DE) { /* so a View window */
 
1569
            if (WhichEvent(ioevent) == Expose)
 
1570
                drawwindow((DEstruct) temp);
 
1571
        } else {
1498
1572
#ifdef USE_FONTSET
1499
1573
            if (XFilterEvent(&ioevent, None)){
1500
1574
                if(ioic){
1566
1640
    DEEvent ioevent;
1567
1641
    int done = 0;
1568
1642
 
1569
 
    while (XPending(iodisplay)) {
 
1643
    while (nView && XPending(iodisplay)) {
1570
1644
        XNextEvent(iodisplay, &ioevent);
1571
1645
        XFindContext(iodisplay, ioevent.xany.window, deContext, &temp);
1572
1646
        DE = (DEstruct) temp;
1606
1680
        free(DE);
1607
1681
        nView--;
1608
1682
        if(nView == 0) {
 
1683
            /* NB: this is removing the handler that is currently
 
1684
               being used: only OK to free here in R > 2.8.0 */
1609
1685
            removeInputHandler(&R_InputHandlers,
1610
1686
                               getInputHandler(R_InputHandlers,fdView));
1611
1687
            fdView = -1;
 
1688
#ifdef USE_FONTSET
 
1689
            if(font_set) {
 
1690
                XFreeFontSet(iodisplay, font_set);
 
1691
                font_set = NULL;
 
1692
            }
 
1693
#endif
1612
1694
            XCloseDisplay(iodisplay);
1613
1695
            iodisplay = NULL;
1614
1696
        }
1823
1905
#endif
1824
1906
    XDestroyWindow(iodisplay, DE->iowindow);
1825
1907
    /* XCloseDisplay(iodisplay); */
 
1908
    Rsync(DE);
1826
1909
}
1827
1910
 
1828
1911
#define USE_Xt 1
1928
2011
            sprintf(opt_fontset_name, s, "medium", "r", 12);
1929
2012
        } else strcpy(opt_fontset_name, fontset_name);
1930
2013
 
1931
 
        font_set = XCreateFontSet(iodisplay, opt_fontset_name,
1932
 
                                  &missing_charset_list,
1933
 
                                  &missing_charset_count, &def_string);
1934
 
        if (missing_charset_count) XFreeStringList(missing_charset_list);
 
2014
        if(font_set == NULL) {
 
2015
            font_set = XCreateFontSet(iodisplay, opt_fontset_name,
 
2016
                                      &missing_charset_list,
 
2017
                                      &missing_charset_count, &def_string);
 
2018
            if (missing_charset_count) XFreeStringList(missing_charset_list);
 
2019
        }
1935
2020
        if (font_set == NULL) {
1936
2021
            warning("unable to create fontset %s", opt_fontset_name);
1937
2022
            return TRUE; /* ERROR */
2099
2184
    DE->iogc = XCreateGC(iodisplay, DE->iowindow, 0, 0);
2100
2185
 
2101
2186
#ifdef USE_FONTSET
2102
 
    if(mbcslocale) {
 
2187
    if(mbcslocale && DE->isEditor) {
2103
2188
        ioim = XOpenIM(iodisplay, NULL, NULL, NULL);
2104
2189
        if(!ioim) {
2105
2190
            XDestroyWindow(iodisplay, DE->iowindow);