Import Tk 8.6.10

This commit is contained in:
Steve Dower
2020-09-24 22:55:34 +01:00
parent 5ba5cbc9af
commit 42c69189d9
365 changed files with 24323 additions and 12832 deletions

View File

@@ -1,8 +1,8 @@
/*
* tkMacOSXFont.c --
*
* Contains the Macintosh implementation of the platform-independant
* font package interface.
* Contains the Macintosh implementation of the platform-independent font
* package interface.
*
* Copyright 2002-2004 Benjamin Riefenstahl, Benjamin.Riefenstahl@epost.de
* Copyright (c) 2006-2009 Daniel A. Steffen <das@users.sourceforge.net>
@@ -32,9 +32,8 @@
*/
typedef struct {
TkFont font; /* Stuff used by generic font package. Must
* be first in structure. */
TkFont font; /* Stuff used by generic font package. Must be
* first in structure. */
NSFont *nsFont;
NSDictionary *nsAttributes;
} MacFont;
@@ -83,27 +82,167 @@ static int antialiasedTextEnabled = -1;
static NSCharacterSet *whitespaceCharacterSet = nil;
static NSCharacterSet *lineendingCharacterSet = nil;
static void GetTkFontAttributesForNSFont(NSFont *nsFont,
TkFontAttributes *faPtr);
static NSFont *FindNSFont(const char *familyName, NSFontTraitMask traits,
NSInteger weight, CGFloat size, int fallbackToDefault);
static void InitFont(NSFont *nsFont, const TkFontAttributes *reqFaPtr,
MacFont * fontPtr);
static int CreateNamedSystemFont(Tcl_Interp *interp, Tk_Window tkwin,
const char* name, TkFontAttributes *faPtr);
static void DrawCharsInContext(Display *display, Drawable drawable, GC gc,
Tk_Font tkfont, const char *source, int numBytes, int rangeStart,
int rangeLength, int x, int y, double angle);
@interface NSFont(TKFont)
- (NSFont *) bestMatchingFontForCharacters: (const UTF16Char *) characters
length: (NSUInteger) length attributes: (NSDictionary *) attributes
actualCoveredLength: (NSUInteger *) coveredLength;
@end
static void GetTkFontAttributesForNSFont(NSFont *nsFont,
TkFontAttributes *faPtr);
static NSFont * FindNSFont(const char *familyName,
NSFontTraitMask traits, NSInteger weight,
CGFloat size, int fallbackToDefault);
static void InitFont(NSFont *nsFont,
const TkFontAttributes *reqFaPtr,
MacFont *fontPtr);
static int CreateNamedSystemFont(Tcl_Interp *interp,
Tk_Window tkwin, const char *name,
TkFontAttributes *faPtr);
static void DrawCharsInContext(Display *display, Drawable drawable,
GC gc, Tk_Font tkfont, const char *source,
int numBytes, int rangeStart, int rangeLength,
int x, int y, double angle);
#pragma mark -
#pragma mark Font Helpers:
/*
*---------------------------------------------------------------------------
*
* TclUniToNSString --
*
* When Tcl is compiled with TCL_UTF_MAX = 3 (the default for 8.6) it cannot
* deal directly with UTF-8 encoded non-BMP characters, since their UTF-8
* encoding requires 4 bytes.
*
* As a workaround, these versions of Tcl encode non-BMP characters as a string
* of length 6 in which the high and low UTF-16 surrogates have been encoded
* using the UTF-8 algorithm. The UTF-8 encoding does not allow encoding
* surrogates, so these 6-byte strings are not valid UTF-8, and hence Apple's
* NString class will refuse to instantiate an NSString from the 6-byte
* encoding. This function allows creating an NSString from a C-string which
* has been encoded using this scheme.
*
* Results:
* An NSString, which may be nil.
*
* Side effects:
* None.
*---------------------------------------------------------------------------
*/
MODULE_SCOPE NSString*
TclUniToNSString(
const char *source,
int numBytes)
{
NSString *string = [[NSString alloc] initWithBytesNoCopy:(void *)source
length:numBytes
encoding:NSUTF8StringEncoding
freeWhenDone:NO];
if (!string) {
const unichar *characters = ckalloc(numBytes*sizeof(unichar));
const char *in = source;
unichar *out = (unichar *) characters;
while (in < source + numBytes) {
in += Tcl_UtfToUniChar(in, out++);
}
string = [[NSString alloc] initWithCharacters:characters
length:(out - characters)];
ckfree(characters);
}
return string;
}
/*
*---------------------------------------------------------------------------
*
* TclUniAtIndex --
*
* Write a sequence of bytes up to length 6 which is an encoding of a UTF-16
* character in an NSString. Also record the unicode code point of the character.
* this may be a non-BMP character constructed by reading two surrogates from
* the NSString.
*
* Results:
* Returns the number of bytes written.
*
* Side effects:
* Bytes are written to the char array referenced by the pointer uni and
* the unicode code point is written to the integer referenced by the
* pointer code.
*
*/
MODULE_SCOPE int
TclUniAtIndex(
NSString *string,
int index,
char *uni,
unsigned int *code)
{
char *ptr = uni;
UniChar uniChar = [string characterAtIndex: index];
if (CFStringIsSurrogateHighCharacter(uniChar)) {
UniChar lowChar = [string characterAtIndex: ++index];
*code = CFStringGetLongCharacterForSurrogatePair(
uniChar, lowChar);
ptr += Tcl_UniCharToUtf(uniChar, ptr);
ptr += Tcl_UniCharToUtf(lowChar, ptr);
return ptr - uni;
} else {
*code = (int) uniChar;
[[string substringWithRange: NSMakeRange(index, 1)]
getCString: uni
maxLength: XMaxTransChars
encoding: NSUTF8StringEncoding];
return strlen(uni);
}
}
/*
*---------------------------------------------------------------------------
*
* NSStringToTclUni --
*
* Encodes the unicode string represented by an NSString object with the
* internal encoding that Tcl uses when TCL_UTF_MAX = 3. This encoding
* is similar to UTF-8 except that non-BMP characters are encoded as two
* successive 3-byte sequences which are constructed from UTF-16 surrogates
* by applying the UTF-8 algorithm. Even though the UTF-8 encoding does not
* allow encoding surrogates, the algorithm does produce a well-defined
* 3-byte sequence.
*
* Results:
* Returns a pointer to a null-terminated byte array which encodes the
* NSString.
*
* Side effects:
* Memory is allocated to hold the byte array, which must be freed with
* ckalloc. If the pointer numBytes is not NULL the number of non-null
* bytes written to the array is stored in the integer it references.
*/
MODULE_SCOPE char*
NSStringToTclUni(
NSString *string,
int *numBytes)
{
unsigned int code;
int i;
char *ptr, *bytes = ckalloc(6*[string length] + 1);
ptr = bytes;
if (ptr) {
for (i = 0; i < [string length]; i++) {
ptr += TclUniAtIndex(string, i, ptr, &code);
if (code > 0xffff){
i++;
}
}
*ptr = '\0';
}
if (numBytes) {
*numBytes = ptr - bytes;
}
return bytes;
}
#define GetNSFontTraitsFromTkFontAttributes(faPtr) \
((faPtr)->weight == TK_FW_BOLD ? NSBoldFontMask : NSUnboldFontMask) | \
((faPtr)->slant == TK_FS_ITALIC ? NSItalicFontMask : NSUnitalicFontMask)
@@ -131,11 +270,11 @@ GetTkFontAttributesForNSFont(
{
NSFontTraitMask traits = [[NSFontManager sharedFontManager]
traitsOfFont:nsFont];
faPtr->family = Tk_GetUid([[nsFont familyName] UTF8String]);
faPtr->size = [nsFont pointSize];
faPtr->weight = (traits & NSBoldFontMask ? TK_FW_BOLD : TK_FW_NORMAL);
faPtr->slant = (traits & NSItalicFontMask ? TK_FS_ITALIC : TK_FS_ROMAN);
}
/*
@@ -179,6 +318,18 @@ FindNSFont(
size = [defaultFont pointSize];
}
nsFont = [fm fontWithFamily:family traits:traits weight:weight size:size];
/*
* A second bug in NSFontManager that Apple created for the Catalina OS
* causes requests as above to sometimes return fonts with additional
* traits that were not requested, even though fonts without those unwanted
* traits exist on the system. See bug [90d555e088]. As a workaround
* we ask the font manager to remove any unrequested traits.
*/
if (nsFont) {
nsFont = [fm convertFont:nsFont toNotHaveTrait:~traits];
}
if (!nsFont) {
NSArray *availableFamilies = [fm availableFontFamilies];
NSString *caseFamily = nil;
@@ -238,7 +389,7 @@ InitFont(
int ascent, descent/*, dontAA*/;
static const UniChar ch[] = {'.', 'W', ' ', 0xc4, 0xc1, 0xc2, 0xc3, 0xc7};
/* ., W, Space, Auml, Aacute, Acirc, Atilde, Ccedilla */
#define nCh (sizeof(ch) / sizeof(UniChar))
#define nCh (sizeof(ch) / sizeof(UniChar))
CGGlyph glyphs[nCh];
CGRect boundingRects[nCh];
@@ -250,7 +401,11 @@ InitFont(
TkInitFontAttributes(faPtr);
}
fontPtr->nsFont = nsFont;
// some don't like antialiasing on fixed-width even if bigger than limit
/*
* Some don't like antialiasing on fixed-width even if bigger than limit
*/
// dontAA = [nsFont isFixedPitch] && fontPtr->font.fa.size <= 10;
if (antialiasedTextEnabled >= 0/* || dontAA*/) {
renderingMode = (antialiasedTextEnabled == 0/* || dontAA*/) ?
@@ -300,7 +455,7 @@ InitFont(
NSLigatureAttributeName,
[NSNumber numberWithDouble:kern], NSKernAttributeName, nil];
fontPtr->nsAttributes = [nsAttributes retain];
#undef nCh
#undef nCh
}
/*
@@ -342,7 +497,7 @@ CreateNamedSystemFont(
*
* This procedure is called when an application is created. It
* initializes all the structures that are used by the
* platform-dependant code on a per application basis.
* platform-dependent code on a per application basis.
* Note that this is called before TkpInit() !
*
* Results:
@@ -364,10 +519,14 @@ TkpFontPkgInit(
NSFont *nsFont;
TkFontAttributes fa;
NSMutableCharacterSet *cs;
/* Since we called before TkpInit, we need our own autorelease pool. */
/*
* Since we called before TkpInit, we need our own autorelease pool.
*/
NSAutoreleasePool *pool = [NSAutoreleasePool new];
/* force this for now */
/*
* Force this for now.
*/
if (!mainPtr->winPtr->mainPtr) {
mainPtr->winPtr->mainPtr = mainPtr;
}
@@ -389,10 +548,25 @@ TkpFontPkgInit(
systemFont++;
}
TkInitFontAttributes(&fa);
#if 0
/*
* In macOS 10.15.1 Apple introduced a bug in NSFontManager which caused
* it to not recognize the familyName ".SF NSMono" which is the familyName
* of the default fixed pitch system fault on that system. See bug [855049e799].
* As a workaround we call [NSFont userFixedPitchFontOfSize:11] instead.
* This returns a user font in the "Menlo" family.
*/
nsFont = (NSFont*) CTFontCreateUIFontForLanguage(fixedPitch, 11, NULL);
#else
nsFont = [NSFont userFixedPitchFontOfSize:11];
#endif
if (nsFont) {
GetTkFontAttributesForNSFont(nsFont, &fa);
#if 0
CFRelease(nsFont);
#endif
} else {
fa.family = Tk_GetUid("Monaco");
fa.size = 11;
@@ -419,17 +593,17 @@ TkpFontPkgInit(
* Map a platform-specific native font name to a TkFont.
*
* Results:
* The return value is a pointer to a TkFont that represents the
* native font. If a native font by the given name could not be
* found, the return value is NULL.
* The return value is a pointer to a TkFont that represents the native
* font. If a native font by the given name could not be found, the return
* value is NULL.
*
* Every call to this procedure returns a new TkFont structure, even
* if the name has already been seen before. The caller should call
* Every call to this procedure returns a new TkFont structure, even if
* the name has already been seen before. The caller should call
* TkpDeleteFont() when the font is no longer needed.
*
* The caller is responsible for initializing the memory associated
* with the generic TkFont when this function returns and releasing
* the contents of the generics TkFont before calling TkpDeleteFont().
* The caller is responsible for initializing the memory associated with
* the generic TkFont when this function returns and releasing the
* contents of the generics TkFont before calling TkpDeleteFont().
*
* Side effects:
* None.
@@ -455,8 +629,8 @@ TkpGetNativeFont(
} else {
return NULL;
}
ctFont = CTFontCreateUIFontForLanguage(HIThemeGetUIFontType(
themeFontId), 0, NULL);
ctFont = CTFontCreateUIFontForLanguage(
HIThemeGetUIFontType(themeFontId), 0, NULL);
if (ctFont) {
fontPtr = ckalloc(sizeof(MacFont));
InitFont((NSFont*) ctFont, NULL, fontPtr);
@@ -474,19 +648,18 @@ TkpGetNativeFont(
* closest matching attributes.
*
* Results:
* The return value is a pointer to a TkFont that represents the font
* with the desired attributes. If a font with the desired attributes
* could not be constructed, some other font will be substituted
* automatically.
* The return value is a pointer to a TkFont that represents the font with
* the desired attributes. If a font with the desired attributes could not
* be constructed, some other font will be substituted automatically.
*
* Every call to this procedure returns a new TkFont structure, even
* if the specified attributes have already been seen before. The
* caller should call TkpDeleteFont() to free the platform- specific
* data when the font is no longer needed.
* Every call to this procedure returns a new TkFont structure, even if
* the specified attributes have already been seen before. The caller
* should call TkpDeleteFont() to free the platform- specific data when
* the font is no longer needed.
*
* The caller is responsible for initializing the memory associated
* with the generic TkFont when this function returns and releasing
* the contents of the generic TkFont before calling TkpDeleteFont().
* The caller is responsible for initializing the memory associated with
* the generic TkFont when this function returns and releasing the
* contents of the generic TkFont before calling TkpDeleteFont().
*
* Side effects:
* None.
@@ -498,16 +671,16 @@ TkFont *
TkpGetFontFromAttributes(
TkFont *tkFontPtr, /* If non-NULL, store the information in this
* existing TkFont structure, rather than
* allocating a new structure to hold the
* font; the existing contents of the font
* will be released. If NULL, a new TkFont
* structure is allocated. */
* allocating a new structure to hold the font;
* the existing contents of the font will be
* released. If NULL, a new TkFont structure is
* allocated. */
Tk_Window tkwin, /* For display where font will be used. */
const TkFontAttributes *faPtr)
/* Set of attributes to match. */
{
MacFont *fontPtr;
int points = (int)(TkFontGetPoints(tkwin, faPtr->size) + 0.5);
int points = (int) (TkFontGetPoints(tkwin, faPtr->size) + 0.5);
NSFontTraitMask traits = GetNSFontTraitsFromTkFontAttributes(faPtr);
NSInteger weight = (faPtr->weight == TK_FW_BOLD ? 9 : 5);
NSFont *nsFont;
@@ -544,9 +717,9 @@ TkpGetFontFromAttributes(
* TkpDeleteFont --
*
* Called to release a font allocated by TkpGetNativeFont() or
* TkpGetFontFromAttributes(). The caller should have already
* released the fields of the TkFont that are used exclusively by the
* generic TkFont code.
* TkpGetFontFromAttributes(). The caller should have already released the
* fields of the TkFont that are used exclusively by the generic TkFont
* code.
*
* Results:
* TkFont is deallocated.
@@ -573,8 +746,8 @@ TkpDeleteFont(
*
* TkpGetFontFamilies --
*
* Return information about the font families that are available on
* the display of the given window.
* Return information about the font families that are available on the
* display of the given window.
*
* Results:
* Modifies interp's result object to hold a list of all the available
@@ -606,12 +779,12 @@ TkpGetFontFamilies(
*
* TkpGetSubFonts --
*
* A function used by the testing package for querying the actual
* screen fonts that make up a font object.
* A function used by the testing package for querying the actual screen
* fonts that make up a font object.
*
* Results:
* Modifies interp's result object to hold a list containing the names
* of the screen fonts that make up the given font object.
* Modifies interp's result object to hold a list containing the names of
* the screen fonts that make up the given font object.
*
* Side effects:
* None.
@@ -648,8 +821,8 @@ TkpGetSubFonts(
*
* TkpGetFontAttrsForChar --
*
* Retrieve the font attributes of the actual font used to render a
* given character.
* Retrieve the font attributes of the actual font used to render a given
* character.
*
* Results:
* None.
@@ -751,10 +924,9 @@ Tk_MeasureChars(
* all the characters on the line for context.
*
* Results:
* The return value is the number of bytes from source that
* fit into the span that extends from 0 to maxLength. *lengthPtr is
* filled with the x-coordinate of the right edge of the last
* character that did fit.
* The return value is the number of bytes from source that fit into the
* span that extends from 0 to maxLength. *lengthPtr is filled with the
* x-coordinate of the right edge of the last character that did fit.
*
* Side effects:
* None.
@@ -780,11 +952,11 @@ TkpMeasureCharsInContext(
* TK_PARTIAL_OK means include the last char
* which only partially fits on this line.
* TK_WHOLE_WORDS means stop on a word
* boundary, if possible. TK_AT_LEAST_ONE
* means return at least one character even
* if no characters fit. If TK_WHOLE_WORDS
* and TK_AT_LEAST_ONE are set and the first
* word doesn't fit, we return at least one
* boundary, if possible. TK_AT_LEAST_ONE means
* return at least one character even if no
* characters fit. If TK_WHOLE_WORDS and
* TK_AT_LEAST_ONE are set and the first word
* doesn't fit, we return at least one
* character or whatever characters fit into
* maxLength. TK_ISOLATE_END means that the
* last character should not be considered in
@@ -814,8 +986,7 @@ TkpMeasureCharsInContext(
if (maxLength > 32767) {
maxLength = 32767;
}
string = [[NSString alloc] initWithBytesNoCopy:(void*)source
length:numBytes encoding:NSUTF8StringEncoding freeWhenDone:NO];
string = TclUniToNSString((const char *)source, numBytes);
if (!string) {
length = 0;
fit = rangeLength;
@@ -870,14 +1041,13 @@ TkpMeasureCharsInContext(
}
/*
* If there is no line breakpoint in the source string between
* its start and the index position that fits in maxWidth, then
* If there is no line breakpoint in the source string between its
* start and the index position that fits in maxWidth, then
* CTTypesetterSuggestLineBreak() returns that very last index.
* However if the TK_WHOLE_WORDS flag is set, we want to break
* at a word boundary. In this situation, unless TK_AT_LEAST_ONE
* is set, we must report that zero chars actually fit (in other
* words the smallest word of the source string is still larger
* than maxWidth).
* However if the TK_WHOLE_WORDS flag is set, we want to break at a
* word boundary. In this situation, unless TK_AT_LEAST_ONE is set, we
* must report that zero chars actually fit (in other words the
* smallest word of the source string is still larger than maxWidth).
*/
if ((index >= start) && (index < len) &&
@@ -909,9 +1079,12 @@ TkpMeasureCharsInContext(
CFRelease(line);
}
/* The call to CTTypesetterSuggestClusterBreak above will always
return at least one character regardless of whether it exceeded
it or not. Clean that up now. */
/*
* The call to CTTypesetterSuggestClusterBreak above will always return
* at least one character regardless of whether it exceeded it or not.
* Clean that up now.
*/
while (width > maxWidth && !(flags & TK_PARTIAL_OK)
&& index > start+(flags & TK_AT_LEAST_ONE)) {
range.length = --index;
@@ -952,7 +1125,7 @@ done:
* actual implementation in TkpDrawCharsInContext().
*
* Results:
* None.
* None.
*
* Side effects:
* Information gets drawn on the screen.
@@ -970,8 +1143,8 @@ Tk_DrawChars(
const char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. All Tk meta-characters
* (tabs, control characters, and newlines)
* should be stripped out of the string that
* is passed to this function. If they are not
* should be stripped out of the string that is
* passed to this function. If they are not
* stripped out, they will be displayed as
* regular printing characters. */
int numBytes, /* Number of bytes in string. */
@@ -992,8 +1165,8 @@ TkDrawAngledChars(
const char *source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. All Tk meta-characters
* (tabs, control characters, and newlines)
* should be stripped out of the string that
* is passed to this function. If they are not
* should be stripped out of the string that is
* passed to this function. If they are not
* stripped out, they will be displayed as
* regular printing characters. */
int numBytes, /* Number of bytes in string. */
@@ -1035,8 +1208,8 @@ TkpDrawCharsInContext(
const char * source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. All Tk meta-characters
* (tabs, control characters, and newlines)
* should be stripped out of the string that
* is passed to this function. If they are not
* should be stripped out of the string that is
* passed to this function. If they are not
* stripped out, they will be displayed as
* regular printing characters. */
int numBytes, /* Number of bytes in string. */
@@ -1060,8 +1233,8 @@ DrawCharsInContext(
const char * source, /* UTF-8 string to be displayed. Need not be
* '\0' terminated. All Tk meta-characters
* (tabs, control characters, and newlines)
* should be stripped out of the string that
* is passed to this function. If they are not
* should be stripped out of the string that is
* passed to this function. If they are not
* stripped out, they will be displayed as
* regular printing characters. */
int numBytes, /* Number of bytes in string. */
@@ -1092,8 +1265,7 @@ DrawCharsInContext(
!TkMacOSXSetupDrawingContext(drawable, gc, 1, &drawingContext)) {
return;
}
string = [[NSString alloc] initWithBytesNoCopy:(void*)source
length:numBytes encoding:NSUTF8StringEncoding freeWhenDone:NO];
string = TclUniToNSString((const char *)source, numBytes);
if (!string) {
return;
}
@@ -1125,6 +1297,7 @@ DrawCharsInContext(
len = Tcl_NumUtfChars(source, rangeStart + rangeLength);
if (start > 0) {
CGRect clipRect = CGRectInfinite, startBounds;
line = CTTypesetterCreateLine(typesetter, CFRangeMake(0, start));
startBounds = CTLineGetImageBounds(line, context);
CFRelease(line);
@@ -1247,9 +1420,10 @@ TkMacOSXFontDescriptionForNSFontAndNSFontAttributes(
NSUnderlineStyleAttributeName];
id strikethrough = [nsAttributes objectForKey:
NSStrikethroughStyleAttributeName];
objv[i++] = Tcl_NewStringObj(familyName, -1);
objv[i++] = Tcl_NewIntObj([nsFont pointSize]);
#define S(s) Tcl_NewStringObj(STRINGIFY(s),(int)(sizeof(STRINGIFY(s))-1))
#define S(s) Tcl_NewStringObj(STRINGIFY(s),(int)(sizeof(STRINGIFY(s))-1))
objv[i++] = (traits & NSBoldFontMask) ? S(bold) : S(normal);
objv[i++] = (traits & NSItalicFontMask) ? S(italic) : S(roman);
if ([underline respondsToSelector:@selector(intValue)] &&
@@ -1273,8 +1447,9 @@ TkMacOSXFontDescriptionForNSFontAndNSFontAttributes(
* TkMacOSXUseAntialiasedText --
*
* Enables or disables application-wide use of antialiased text (where
* available). Sets up a linked Tcl global variable to allow
* disabling of antialiased text from tcl.
* available). Sets up a linked Tcl global variable to allow disabling of
* antialiased text from Tcl.
*
* The possible values for this variable are:
*
* -1 - Use system default as configurable in "System Prefs" -> "General".