First, experimental implementation of TIP #575. Barely tested, will fail. WIP

1 files changed, 31 insertions, 3 deletions

diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 2d2bc63..ae9a4e3 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -88,6 +88,31 @@ static void uniCodePanic(void) {
 #   define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic
 #endif
 
+#define TclUtfCharComplete UtfCharComplete
+#define TclUtfNext UtfNext
+#define TclUtfPrev UtfPrev
+
+static int TclUtfCharComplete(const char *src, int length) {
+	if ((unsigned)((unsigned char)*(src) - 0xF0) < 5) {
+		return length < 5;
+	}
+    return Tcl_UtfCharComplete(src, length);
+}
+
+static const char *TclUtfNext(const char *src) {
+	if ((unsigned)((unsigned char)*(src) - 0xF0) < 5) {
+		return src + 1;
+	}
+    return Tcl_UtfNext(src);
+}
+
+static const char *TclUtfPrev(const char *src, const char *start) {
+	if (((unsigned)((unsigned char)*(src) - 0xF0) < 5) && (src >= start)) {
+		return src - 1;
+	}
+    return Tcl_UtfPrev(src, start);
+}
+
 #define TclBN_mp_add mp_add
 #define TclBN_mp_and mp_and
 #define TclBN_mp_clamp mp_clamp
@@ -1549,12 +1574,12 @@ const TclStubs tclStubs = {
     Tcl_UniCharToUpper, /* 323 */
     Tcl_UniCharToUtf, /* 324 */
     Tcl_UtfAtIndex, /* 325 */
-    Tcl_UtfCharComplete, /* 326 */
+    TclUtfCharComplete, /* 326 */
     Tcl_UtfBackslash, /* 327 */
     Tcl_UtfFindFirst, /* 328 */
     Tcl_UtfFindLast, /* 329 */
-    Tcl_UtfNext, /* 330 */
-    Tcl_UtfPrev, /* 331 */
+    TclUtfNext, /* 330 */
+    TclUtfPrev, /* 331 */
     Tcl_UtfToExternal, /* 332 */
     Tcl_UtfToExternalDString, /* 333 */
     Tcl_UtfToLower, /* 334 */
@@ -1872,6 +1897,9 @@ const TclStubs tclStubs = {
     Tcl_UtfToUniChar, /* 646 */
     Tcl_UniCharToUtfDString, /* 647 */
     Tcl_UtfToUniCharDString, /* 648 */
+    Tcl_UtfCharComplete, /* 649 */
+    Tcl_UtfNext, /* 650 */
+    Tcl_UtfPrev, /* 651 */
 };
 
 /* !END!: Do not edit above this line. */