From 387766b8dc96912fac2f0cf7f1a29f32c4951faf Mon Sep 17 00:00:00 2001
From: culler <culler>
Date: Tue, 10 Nov 2020 19:39:45 +0000
Subject: For Aqua, a real implementation of endOfGlyphCluster and
 startOfGlyphCluster.  Makes entry editing fully functional.

---
 library/tk.tcl        |  55 +++++++++++++++------------
 macosx/tkMacOSXFont.c | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 132 insertions(+), 23 deletions(-)

diff --git a/library/tk.tcl b/library/tk.tcl
index b1b7629..559af38 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -700,34 +700,43 @@ if {[tk windowingsystem] eq "aqua"} {
     }
 }
 
-proc ::tk::endOfGlyphCluster {str start} {
-    if {$start >= [string length $str]} {
-	return -1;
-    }
-    if {[string length [string index $str $start]] > 1} {
-	set start [expr {$start+1}]
+if {[tk windowingsystem] eq "aqua"} {
+    proc ::tk::endOfGlyphCluster {str index} {
+	return [endOfGlyph $str $index]
     }
-    set start [expr {$start+1}]
-    if {[string index $str $start] eq {^}} {
-	set start [expr {$start+1}];# For demo purposes only
+    proc ::tk::startOfGlyphCluster {str index} {
+	return [startOfGlyph $str $index]
     }
-    return $start
+} else {
+    proc ::tk::endOfGlyphCluster {str start} {
+	if {$start >= [string length $str]} {
+	    return -1;
+	}
+	if {[string length [string index $str $start]] > 1} {
+	    set start [expr {$start+1}]
+	}
+	set start [expr {$start+1}]
+	if {[string index $str $start] eq {^}} {
+	    set start [expr {$start+1}];# For demo purposes only
+	}
+	return $start
 }
 
-proc ::tk::startOfGlyphCluster {str start} {
-    if {$start eq "end"} {
-	set start [expr {[string length $str]-1}]
-    }
-    if {$start < 0} {
-	return -1;
-    }
-    if {[string index $str $start] eq {^}} {
-	set start [expr {$start-1}];# For demo purposes only
-    }
-    if {[string length [string index $str [expr {$start-1}]]] > 1} {
-	return [expr {$start-1}]
+    proc ::tk::startOfGlyphCluster {str start} {
+	if {$start eq "end"} {
+	    set start [expr {[string length $str]-1}]
+	}
+	if {$start < 0} {
+	    return -1;
+	}
+	if {[string index $str $start] eq {^}} {
+	    set start [expr {$start-1}];# For demo purposes only
+	}
+	if {[string length [string index $str [expr {$start-1}]]] > 1} {
+	    return [expr {$start-1}]
+	}
+	return $start
     }
-    return $start
 }
 
 # Create a dictionary to store the starting index of the IME marked
diff --git a/macosx/tkMacOSXFont.c b/macosx/tkMacOSXFont.c
index 6c66ed8..11d690c 100644
--- a/macosx/tkMacOSXFont.c
+++ b/macosx/tkMacOSXFont.c
@@ -149,6 +149,16 @@ static int		CreateNamedSystemFont(Tcl_Interp *interp,
     return [_string characterAtIndex:index];
 }
 
+- (NSUInteger)startOfGlyphCluster:(NSUInteger)index
+{
+    NSRange range = [_string rangeOfComposedCharacterSequenceAtIndex:index];
+    return range.location;
+}
+- (NSUInteger)endOfGlyphCluster:(NSUInteger)index
+{
+    NSRange range = [_string rangeOfComposedCharacterSequenceAtIndex:index];
+    return range.location + range.length;
+}
 # ifndef __clang__
 @synthesize DString = _ds;
 #endif
@@ -425,6 +435,94 @@ CreateNamedSystemFont(
 }
 
 #pragma mark -
+
+#pragma mark Glyph indexing
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * startOfGlyphObjCmd --
+ *
+ *      This function is invoked to process the startOfGlyph command.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      None
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+startOfGlyphObjCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,         /* Current interpreter. */
+    int objc,                   /* Number of arguments. */
+    Tcl_Obj *const objv[])      /* Argument objects. */
+{
+    TKNSString *S;
+    const char *stringArg;
+    int numBytes;
+    Tcl_WideInt indexArg;
+    Tcl_WideInt result;
+    if ((objc != 3)) {
+        Tcl_WrongNumArgs(interp, 1, objv, "string index"); 
+        return TCL_ERROR;
+    }
+    stringArg = Tcl_GetStringFromObj(objv[1], &numBytes);
+    if (stringArg == NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetWideIntFromObj(interp, objv[2], &indexArg) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes];
+    if ((unsigned long long) indexArg >= [S length]) {
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj([S length]));
+	return TCL_OK;
+    }
+    result = indexArg >= 0 ? [S startOfGlyphCluster:indexArg] : -1;
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
+    return TCL_OK;
+}	
+
+static int
+endOfGlyphObjCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,         /* Current interpreter. */
+    int objc,                   /* Number of arguments. */
+    Tcl_Obj *const objv[])      /* Argument objects. */
+{
+    TKNSString *S;
+    char *stringArg;
+    int numBytes;
+    Tcl_WideInt indexArg;
+    Tcl_WideInt result;
+    
+    if ((objc != 3)) {
+        Tcl_WrongNumArgs(interp, 1, objv, "string index");
+        return TCL_ERROR;
+    }
+    stringArg = Tcl_GetStringFromObj(objv[1], &numBytes);
+    if (stringArg == NULL) {
+	return TCL_ERROR;
+    }
+    if (Tcl_GetWideIntFromObj(interp, objv[2], &indexArg) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (indexArg < 0) {
+	Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
+	return TCL_OK;
+    }
+    S = [[TKNSString alloc] initWithTclUtfBytes:stringArg length:numBytes];
+    result = (unsigned long long) indexArg < [S length] ?
+	[S endOfGlyphCluster:indexArg] : [S length];
+    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
+    return TCL_OK;
+}	
+
+#pragma mark -
 #pragma mark Font handling:
 
 /*
@@ -520,6 +618,8 @@ TkpFontPkgInit(
 	[cs release];
     }
     [pool drain];
+    Tcl_CreateObjCommand(interp, "startOfGlyph", startOfGlyphObjCmd, NULL, NULL);
+    Tcl_CreateObjCommand(interp, "endOfGlyph", endOfGlyphObjCmd, NULL, NULL);
 }
 
 /*
-- 
cgit v0.12