X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=utf8.c;h=d73809c1640ba4ecbb66a04f13d10d2bab402a6f;hb=158e3910f3d0bce487277fa0db25247b664ed87c;hp=768db078b807798de71c5f236a14027212c1fcc0;hpb=b4e400f9f0f3998e635cdce0c2d2e790cbe42caa;p=p5sagit%2Fp5-mst-13.2.git diff --git a/utf8.c b/utf8.c index 768db07..d73809c 100644 --- a/utf8.c +++ b/utf8.c @@ -1180,6 +1180,30 @@ Perl_is_utf8_mark(pTHX_ U8 *p) return swash_fetch(PL_utf8_mark, p, TRUE); } +/* +=for apidoc A|UV|to_utf8_case|U8 *p|U8* ustrp|STRLEN *lenp|SV **swash|char *normal|char *special + +The "p" contains the pointer to the UTF-8 string encoding +the character that is being converted. + +The "ustrp" is a pointer to the character buffer to put the +conversion result to. The "lenp" is a pointer to the length +of the result. + +The "swash" is a pointer to the swash to use. + +The "normal" is a string like "ToLower" which means the swash +$utf8::ToLower, which is stored in lib/unicore/To/Lower.pl, +and loaded by SWASHGET, using lib/utf8_heavy.pl. + +The "special" is a string like "utf8::ToSpecLower", which means +the hash %utf8::ToSpecLower, which is stored in the same file, +lib/unicore/To/Lower.pl, and also loaded by SWASHGET. The access +to the hash is by Perl_to_utf8_case(). + +=cut + */ + UV Perl_to_utf8_case(pTHX_ U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp,char *normal, char *special) { @@ -1320,7 +1344,7 @@ Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr, bool do_utf8) U32 off; STRLEN slen; STRLEN needents; - U8 *tmps; + U8 *tmps = NULL; U32 bit; SV *retval; U8 tmputf8[2]; @@ -1491,4 +1515,31 @@ Perl_utf8n_to_uvchr(pTHX_ U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) return UNI_TO_NATIVE(uv); } +char * +Perl_pv_uni_display(pTHX_ SV *dsv, U8 *spv, STRLEN len, STRLEN pvlim, UV flags) +{ + int truncated = 0; + char *s, *e; + + sv_setpvn(dsv, "", 0); + for (s = (char *)spv, e = s + len; s < e; s += UTF8SKIP(s)) { + UV u; + if (pvlim && SvCUR(dsv) >= pvlim) { + truncated++; + break; + } + u = utf8_to_uvchr((U8*)s, 0); + Perl_sv_catpvf(aTHX_ dsv, "\\x{%"UVxf"}", u); + } + if (truncated) + sv_catpvn(dsv, "...", 3); + + return SvPVX(dsv); +} +char * +Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags) +{ + return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv), + pvlim, flags); +}