← Back to branch summary

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

« back to all changes in this revision

Viewing changes to src/main/character.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/main/character.c
19
19
 *  http://www.r-project.org/Licenses/
20
20
 */
21
21
 
22
 
/* <UTF8>
23
 
   abbreviate needs to be fixed, if possible.
24
 
 
25
 
   Changes already made:
26
 
   abbreviate needs to be fixed, if possible, but warns for now.
27
 
   Regex code should be OK, substitution does ASCII comparisons only.
28
 
   charToRaw/rawToChar should work at byte level, so is OK.
29
 
   agrep needed to work at char level.
30
 
   make.names worked at byte not char level.
31
 
   substr() should work at char not byte level.
32
 
   Semantics of nchar() have been fixed.
33
 
   regexpr returned pos and match length in bytes not chars.
34
 
   tolower/toupper added wchar versions
35
 
   chartr works at char not byte level.
36
 
 */
37
 
 
38
22
#ifdef HAVE_CONFIG_H
39
23
# include <config.h>
40
24
#endif
90
74
    checkArity(op, args);
91
75
    PROTECT(x = coerceVector(CAR(args), STRSXP));
92
76
    if (!isString(x))
93
 
        error(_("nchar() requires a character vector"));
 
77
        error(_("'%s' requires a character vector"), "nzchar()");
94
78
    len = LENGTH(x);
95
79
    PROTECT(ans = allocVector(LGLSXP, len));
96
80
    for (i = 0; i < len; i++)
97
 
        LOGICAL(ans)[i] = length(STRING_ELT(x, i)) > 0;
 
81
        LOGICAL(ans)[i] = LENGTH(STRING_ELT(x, i)) > 0;
98
82
    UNPROTECT(2);
99
83
    return ans;
100
84
}
114
98
    checkArity(op, args);
115
99
    PROTECT(x = coerceVector(CAR(args), STRSXP));
116
100
    if (!isString(x))
117
 
        error(_("nchar() requires a character vector"));
 
101
        error(_("'%s' requires a character vector"), "nchar()");
118
102
    len = LENGTH(x);
119
103
    stype = CADR(args);
120
104
    if (!isString(stype) || LENGTH(stype) != 1)
134
118
        }
135
119
        if (strncmp(type, "bytes", ntype) == 0) {
136
120
            /* This case counts embedded nuls */
137
 
            INTEGER(s)[i] = length(sxi);
 
121
            INTEGER(s)[i] = LENGTH(sxi);
138
122
        } else if (strncmp(type, "chars", ntype) == 0) {
139
123
#ifdef SUPPORT_MBCS
140
124
            /* only on Windows will non-representable UTF-8 chars be
141
 
               usefully ouptut as chars and not <U+xxxx> */
142
 
# ifdef Win32
 
125
               usefully output as chars and not <U+xxxx> */
143
126
            if (IS_UTF8(sxi)) { /* assume this is valid */
144
127
                const char *p = CHAR(sxi);
145
128
                nc = 0;
146
129
                for( ; *p; p +=utf8clen(*p)) nc++;
147
130
                INTEGER(s)[i] = nc;
148
 
            } else
149
 
# endif
150
 
            if (mbcslocale) {
 
131
            } else if (mbcslocale) {
151
132
                nc = mbstowcs(NULL, translateChar(sxi), 0);
152
133
                if (!allowNA && nc < 0)
153
134
                    error(_("invalid multibyte string %d"), i+1);
157
138
                INTEGER(s)[i] = strlen(translateChar(sxi));
158
139
        } else if (strncmp(type, "width", ntype) == 0) {
159
140
#ifdef SUPPORT_MBCS
160
 
# ifdef Win32
161
141
            if (IS_UTF8(sxi)) { /* assume this is valid */
162
142
                const char *p = CHAR(sxi);
163
143
                wchar_t wc1;
167
147
                    nc +=Ri18n_wcwidth(wc1);
168
148
                }
169
149
                INTEGER(s)[i] = nc;
170
 
            } else
171
 
# endif
172
 
            if (mbcslocale) {
 
150
            } else if (mbcslocale) {
173
151
                xi = translateChar(sxi);
174
152
                nc = mbstowcs(NULL, xi, 0);
175
153
                if (nc >= 0) {
286
264
static void
287
265
substrset(char *buf, const char *const str, cetype_t ienc, int sa, int so)
288
266
{
289
 
    /* Replace the substring buf[sa:so] by str[],
290
 
       or as much as str provides */
 
267
    /* Replace the substring buf[sa:so] by str[] */
291
268
    int i, in = 0, out = 0;
292
269
 
293
270
    if (ienc == CE_UTF8) {
2809
2786
        len = LENGTH(x);
2810
2787
        PROTECT(ans = allocVector(STRSXP, 1));
2811
2788
        /* String is not necessarily 0-terminated and may contain nuls
2812
 
           so don't use mkChar */
2813
 
        SET_STRING_ELT(ans, 0, mkCharLen((const char *)RAW(x), len));
 
2789
           so don't use mkString */
 
2790
        SET_STRING_ELT(ans, 0,
 
2791
                       mkCharLenCE((const char *)RAW(x), len, CE_NATIVE));
2814
2792
    }
2815
2793
    UNPROTECT(1);
2816
2794
    return ans;
2857
2835
 
2858
2836
SEXP attribute_hidden do_intToBits(SEXP call, SEXP op, SEXP args, SEXP env)
2859
2837
{
2860
 
    SEXP ans, x = CAR(args);
 
2838
    SEXP ans, x;
2861
2839
    int i, j = 0, k;
2862
2840
    unsigned int tmp;
2863
 
 
 
2841
    
 
2842
    PROTECT(x = coerceVector(CAR(args), INTSXP));
2864
2843
    if (!isInteger(x))
2865
 
        error(_("argument 'x' must be a integer vector"));
 
2844
        error(_("argument 'x' must be an integer vector"));
2866
2845
    PROTECT(ans = allocVector(RAWSXP, 32*LENGTH(x)));
2867
2846
    for (i = 0; i < LENGTH(x); i++) {
2868
2847
        tmp = (unsigned int) INTEGER(x)[i];
2869
2848
        for (k = 0; k < 32; k++, tmp >>= 1)
2870
2849
            RAW(ans)[j++] = tmp & 0x1;
2871
2850
    }
2872
 
    UNPROTECT(1);
 
2851
    UNPROTECT(2);
2873
2852
    return ans;
2874
2853
}
2875
2854
 
3049
3028
 
3050
3029
SEXP attribute_hidden do_intToUtf8(SEXP call, SEXP op, SEXP args, SEXP env)
3051
3030
{
3052
 
    SEXP ans, c, x = CAR(args);
3053
 
    int i, nc = LENGTH(x), multiple, len, used;
3054
 
    char buf[10];
 
3031
    SEXP ans, x;
 
3032
    int i, nc, multiple, len, used;
 
3033
    char buf[10], *tmp;
3055
3034
 
3056
3035
    checkArity(op, args);
 
3036
    PROTECT(x = coerceVector(CAR(args), INTSXP));
3057
3037
    if (!isInteger(x))
3058
3038
        error(_("argument 'x' must be an integer vector"));
 
3039
    nc = LENGTH(x);
3059
3040
    multiple = asLogical(CADR(args));
3060
3041
    if (multiple == NA_LOGICAL)
3061
3042
        error(_("argument 'multiple' must be TRUE or FALSE"));
3068
3049
        }
3069
3050
        /* do we want to copy e.g. names here? */
3070
3051
    } else {
 
3052
        /* Note that this gives zero length for input '0', so it is omitted */
3071
3053
        for (i = 0, len = 0; i < nc; i++)
3072
3054
            len += inttomb(NULL, INTEGER(x)[i]);
3073
 
        PROTECT(ans = allocVector(STRSXP, 1));
3074
 
        /* String is not necessarily 0-terminated and may contain nuls
3075
 
           so don't use mkChar */
3076
 
        c = allocString(len); /* adds zero terminator */
 
3055
        tmp = alloca(len);
 
3056
        R_CheckStack();
3077
3057
        for (i = 0, len = 0; i < nc; i++) {
3078
3058
            used = inttomb(buf, INTEGER(x)[i]);
3079
 
            strncpy(CHAR_RW(c) + len, buf, used);
3080
 
            SET_UTF8(c);
 
3059
            strncpy(tmp + len, buf, used);
3081
3060
            len += used;
3082
3061
        }
3083
 
        SET_STRING_ELT(ans, 0, c);
 
3062
        PROTECT(ans = allocVector(STRSXP, 1));
 
3063
        SET_STRING_ELT(ans, 0, mkCharLenCE(tmp, len, CE_UTF8));
3084
3064
    }
3085
 
    UNPROTECT(1);
 
3065
    UNPROTECT(2);
3086
3066
    return ans;
3087
3067
}
3088
3068
 
3219
3199
    {
3220
3200
        wchar_t *w = globbuf.gl_pathv[i];
3221
3201
        char *buf;
3222
 
        int n = wcslen(w);
3223
 
        buf = R_AllocStringBuffer(2*(n+1), &cbuff);
3224
 
        wcstoutf8(buf, w, n+1);
3225
 
        SET_STRING_ELT(ans, i, mkChar(buf));
 
3202
        int nb = wcstoutf8(NULL, w, 0);
 
3203
        buf = R_AllocStringBuffer(nb+1, &cbuff);
 
3204
        wcstoutf8(buf, w, nb+1); buf[nb] = '\0'; /* safety check */
 
3205
        SET_STRING_ELT(ans, i, mkCharCE(buf, CE_UTF8));
3226
3206
    }
3227
3207
#else
3228
3208
        SET_STRING_ELT(ans, i, mkChar(globbuf.gl_pathv[i]));