1 /*
2 * tkFont.c --
3 *
4 * This file maintains a database of fonts for the Tk toolkit.
5 * It also provides several utility procedures for measuring and
6 * displaying text.
7 *
8 * Copyright (c) 1990-1994 The Regents of the University of California.
9 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
10 *
11 * See the file "license.terms" for information on usage and redistribution
12 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13 *
14 * RCS: @(#) $Id: tkFont.c,v 1.21 2002/09/02 19:13:47 hobbs Exp $
15 */
16
17 #include "tkPort.h"
18 #include "tkInt.h"
19 #include "tkFont.h"
20
21 /*
22 * The following structure is used to keep track of all the fonts that
23 * exist in the current application. It must be stored in the
24 * TkMainInfo for the application.
25 */
26
27 typedef struct TkFontInfo {
28 Tcl_HashTable fontCache; /* Map a string to an existing Tk_Font.
29 * Keys are string font names, values are
30 * TkFont pointers. */
31 Tcl_HashTable namedTable; /* Map a name to a set of attributes for a
32 * font, used when constructing a Tk_Font from
33 * a named font description. Keys are
34 * strings, values are NamedFont pointers. */
35 TkMainInfo *mainPtr; /* Application that owns this structure. */
36 int updatePending; /* Non-zero when a World Changed event has
37 * already been queued to handle a change to
38 * a named font. */
39 } TkFontInfo;
40
41 /*
42 * The following data structure is used to keep track of the font attributes
43 * for each named font that has been defined. The named font is only deleted
44 * when the last reference to it goes away.
45 */
46
47 typedef struct NamedFont {
48 int refCount; /* Number of users of named font. */
49 int deletePending; /* Non-zero if font should be deleted when
50 * last reference goes away. */
51 TkFontAttributes fa; /* Desired attributes for named font. */
52 } NamedFont;
53
54 /*
55 * The following two structures are used to keep track of string
56 * measurement information when using the text layout facilities.
57 *
58 * A LayoutChunk represents a contiguous range of text that can be measured
59 * and displayed by low-level text calls. In general, chunks will be
60 * delimited by newlines and tabs. Low-level, platform-specific things
61 * like kerning and non-integer character widths may occur between the
62 * characters in a single chunk, but not between characters in different
63 * chunks.
64 *
65 * A TextLayout is a collection of LayoutChunks. It can be displayed with
66 * respect to any origin. It is the implementation of the Tk_TextLayout
67 * opaque token.
68 */
69
70 typedef struct LayoutChunk {
71 CONST char *start; /* Pointer to simple string to be displayed.
72 * This is a pointer into the TkTextLayout's
73 * string. */
74 int numBytes; /* The number of bytes in this chunk. */
75 int numChars; /* The number of characters in this chunk. */
76 int numDisplayChars; /* The number of characters to display when
77 * this chunk is displayed. Can be less than
78 * numChars if extra space characters were
79 * absorbed by the end of the chunk. This
80 * will be < 0 if this is a chunk that is
81 * holding a tab or newline. */
82 int x, y; /* The origin of the first character in this
83 * chunk with respect to the upper-left hand
84 * corner of the TextLayout. */
85 int totalWidth; /* Width in pixels of this chunk. Used
86 * when hit testing the invisible spaces at
87 * the end of a chunk. */
88 int displayWidth; /* Width in pixels of the displayable
89 * characters in this chunk. Can be less than
90 * width if extra space characters were
91 * absorbed by the end of the chunk. */
92 } LayoutChunk;
93
94 typedef struct TextLayout {
95 Tk_Font tkfont; /* The font used when laying out the text. */
96 CONST char *string; /* The string that was layed out. */
97 int width; /* The maximum width of all lines in the
98 * text layout. */
99 int numChunks; /* Number of chunks actually used in
100 * following array. */
101 LayoutChunk chunks[1]; /* Array of chunks. The actual size will
102 * be maxChunks. THIS FIELD MUST BE THE LAST
103 * IN THE STRUCTURE. */
104 } TextLayout;
105
106 /*
107 * The following structures are used as two-way maps between the values for
108 * the fields in the TkFontAttributes structure and the strings used in
109 * Tcl, when parsing both option-value format and style-list format font
110 * name strings.
111 */
112
113 static TkStateMap weightMap[] = {
114 {TK_FW_NORMAL, "normal"},
115 {TK_FW_BOLD, "bold"},
116 /* These are additions from the X world */
117 {TK_FW_NORMAL, "medium"},
118 {TK_FW_NORMAL, "book"},
119 {TK_FW_NORMAL, "light"},
120 {TK_FW_BOLD, "demi"},
121 {TK_FW_BOLD, "demibold"},
122 {TK_FW_UNKNOWN, NULL}
123 };
124
125 static TkStateMap slantMap[] = {
126 {TK_FS_ROMAN, "roman"},
127 {TK_FS_ITALIC, "italic"},
128 /* These are additions from the X world */
129 {TK_FS_ROMAN, "r"},
130 {TK_FS_ITALIC, "i"},
131 {TK_FS_ITALIC, "o"},
132 {TK_FS_UNKNOWN, NULL}
133 };
134
135 static TkStateMap underlineMap[] = {
136 {1, "underline"},
137 {0, NULL}
138 };
139
140 static TkStateMap overstrikeMap[] = {
141 {1, "overstrike"},
142 {0, NULL}
143 };
144
145 /*
146 * The following structures are used when parsing XLFD's into a set of
147 * TkFontAttributes.
148 */
149
150 static TkStateMap xlfdWeightMap[] = {
151 {TK_FW_NORMAL, "normal"},
152 {TK_FW_NORMAL, "medium"},
153 {TK_FW_NORMAL, "book"},
154 {TK_FW_NORMAL, "light"},
155 {TK_FW_BOLD, "bold"},
156 {TK_FW_BOLD, "demi"},
157 {TK_FW_BOLD, "demibold"},
158 {TK_FW_NORMAL, NULL} /* Assume anything else is "normal". */
159 };
160
161 static TkStateMap xlfdSlantMap[] = {
162 {TK_FS_ROMAN, "r"},
163 {TK_FS_ITALIC, "i"},
164 {TK_FS_OBLIQUE, "o"},
165 {TK_FS_ROMAN, NULL} /* Assume anything else is "roman". */
166 };
167
168 static TkStateMap xlfdSetwidthMap[] = {
169 {TK_SW_NORMAL, "normal"},
170 {TK_SW_CONDENSE, "narrow"},
171 {TK_SW_CONDENSE, "semicondensed"},
172 {TK_SW_CONDENSE, "condensed"},
173 {TK_SW_UNKNOWN, NULL}
174 };
175
176 /*
177 * The following structure and defines specify the valid builtin options
178 * when configuring a set of font attributes.
179 */
180
181 static CONST char *fontOpt[] = {
182 "-family",
183 "-size",
184 "-weight",
185 "-slant",
186 "-underline",
187 "-overstrike",
188 NULL
189 };
190
191 #define FONT_FAMILY 0
192 #define FONT_SIZE 1
193 #define FONT_WEIGHT 2
194 #define FONT_SLANT 3
195 #define FONT_UNDERLINE 4
196 #define FONT_OVERSTRIKE 5
197 #define FONT_NUMFIELDS 6
198
199 /*
200 * Hardcoded font aliases. These are used to describe (mostly) identical
201 * fonts whose names differ from platform to platform. If the
202 * user-supplied font name matches any of the names in one of the alias
203 * lists, the other names in the alias list are also automatically tried.
204 */
205
206 static char *timesAliases[] = {
207 "Times", /* Unix. */
208 "Times New Roman", /* Windows. */
209 "New York", /* Mac. */
210 NULL
211 };
212
213 static char *helveticaAliases[] = {
214 "Helvetica", /* Unix. */
215 "Arial", /* Windows. */
216 "Geneva", /* Mac. */
217 NULL
218 };
219
220 static char *courierAliases[] = {
221 "Courier", /* Unix and Mac. */
222 "Courier New", /* Windows. */
223 NULL
224 };
225
226 static char *minchoAliases[] = {
227 "mincho", /* Unix. */
228 "\357\274\255\357\274\263 \346\230\216\346\234\235",
229 /* Windows (MS mincho). */
230 "\346\234\254\346\230\216\346\234\235\342\210\222\357\274\255",
231 /* Mac (honmincho-M). */
232 NULL
233 };
234
235 static char *gothicAliases[] = {
236 "gothic", /* Unix. */
237 "\357\274\255\357\274\263 \343\202\264\343\202\267\343\203\203\343\202\257",
238 /* Windows (MS goshikku). */
239 "\344\270\270\343\202\264\343\202\267\343\203\203\343\202\257\342\210\222\357\274\255",
240 /* Mac (goshikku-M). */
241 NULL
242 };
243
244 static char *dingbatsAliases[] = {
245 "dingbats", "zapfdingbats", "itc zapfdingbats",
246 /* Unix. */
247 /* Windows. */
248 "zapf dingbats", /* Mac. */
249 NULL
250 };
251
252 static char **fontAliases[] = {
253 timesAliases,
254 helveticaAliases,
255 courierAliases,
256 minchoAliases,
257 gothicAliases,
258 dingbatsAliases,
259 NULL
260 };
261
262 /*
263 * Hardcoded font classes. If the character cannot be found in the base
264 * font, the classes are examined in order to see if some other similar
265 * font should be examined also.
266 */
267
268 static char *systemClass[] = {
269 "fixed", /* Unix. */
270 /* Windows. */
271 "chicago", "osaka", "sistemny", /* Mac. */
272 NULL
273 };
274
275 static char *serifClass[] = {
276 "times", "palatino", "mincho", /* All platforms. */
277 "song ti", /* Unix. */
278 "ms serif", "simplified arabic", /* Windows. */
279 "latinski", /* Mac. */
280 NULL
281 };
282
283 static char *sansClass[] = {
284 "helvetica", "gothic", /* All platforms. */
285 /* Unix. */
286 "arial unicode ms", /* MS Office etc. */
287 "ms sans serif", "traditional arabic",
288 /* Windows. */
289 "bastion", /* Mac. */
290 NULL
291 };
292
293 static char *monoClass[] = {
294 "courier", "gothic", /* All platforms. */
295 "fangsong ti", /* Unix. */
296 "simplified arabic fixed", /* Windows. */
297 "monaco", "pryamoy", /* Mac. */
298 NULL
299 };
300
301 static char *symbolClass[] = {
302 "symbol", "dingbats", "wingdings", NULL
303 };
304
305 static char **fontFallbacks[] = {
306 systemClass,
307 serifClass,
308 sansClass,
309 monoClass,
310 symbolClass,
311 NULL
312 };
313
314 /*
315 * Global fallbacks. If the character could not be found in the preferred
316 * fallback list, this list is examined. If the character still cannot be
317 * found, all font families in the system are examined.
318 */
319
320 static char *globalFontClass[] = {
321 "symbol", /* All platforms. */
322 /* Unix. */
323 "lucida sans unicode", /* Windows. */
324 "bitstream cyberbit", /* Windows popular CJK font */
325 "chicago", /* Mac. */
326 "fixed", /* X11 font with growing repertoire */
327 "arial unicode ms", /* MS Office etc. */
328 "unifont", /* GNU font with wide repertoire but ugly */
329 NULL
330 };
331
332 #define GetFontAttributes(tkfont) \
333 ((CONST TkFontAttributes *) &((TkFont *) (tkfont))->fa)
334
335 #define GetFontMetrics(tkfont) \
336 ((CONST TkFontMetrics *) &((TkFont *) (tkfont))->fm)
337
338
339 static int ConfigAttributesObj _ANSI_ARGS_((Tcl_Interp *interp,
340 Tk_Window tkwin, int objc, Tcl_Obj *CONST objv[],
341 TkFontAttributes *faPtr));
342 static int CreateNamedFont _ANSI_ARGS_((Tcl_Interp *interp,
343 Tk_Window tkwin, CONST char *name,
344 TkFontAttributes *faPtr));
345 static void DupFontObjProc _ANSI_ARGS_((Tcl_Obj *srcObjPtr,
346 Tcl_Obj *dupObjPtr));
347 static int FieldSpecified _ANSI_ARGS_((CONST char *field));
348 static void FreeFontObjProc _ANSI_ARGS_((Tcl_Obj *objPtr));
349 static int GetAttributeInfoObj _ANSI_ARGS_((Tcl_Interp *interp,
350 CONST TkFontAttributes *faPtr, Tcl_Obj *objPtr));
351 static LayoutChunk * NewChunk _ANSI_ARGS_((TextLayout **layoutPtrPtr,
352 int *maxPtr, CONST char *start, int numChars,
353 int curX, int newX, int y));
354 static int ParseFontNameObj _ANSI_ARGS_((Tcl_Interp *interp,
355 Tk_Window tkwin, Tcl_Obj *objPtr,
356 TkFontAttributes *faPtr));
357 static void RecomputeWidgets _ANSI_ARGS_((TkWindow *winPtr));
358 static int SetFontFromAny _ANSI_ARGS_((Tcl_Interp *interp,
359 Tcl_Obj *objPtr));
360 static void TheWorldHasChanged _ANSI_ARGS_((
361 ClientData clientData));
362 static void UpdateDependentFonts _ANSI_ARGS_((TkFontInfo *fiPtr,
363 Tk_Window tkwin, Tcl_HashEntry *namedHashPtr));
364
365 /*
366 * The following structure defines the implementation of the "font" Tcl
367 * object, used for drawing. The internalRep.twoPtrValue.ptr1 field of
368 * each font object points to the TkFont structure for the font, or
369 * NULL.
370 */
371
372 Tcl_ObjType tkFontObjType = {
373 "font", /* name */
374 FreeFontObjProc, /* freeIntRepProc */
375 DupFontObjProc, /* dupIntRepProc */
376 NULL, /* updateStringProc */
377 SetFontFromAny /* setFromAnyProc */
378 };
379
380
381 /*
382 *---------------------------------------------------------------------------
383 *
384 * TkFontPkgInit --
385 *
386 * This procedure is called when an application is created. It
387 * initializes all the structures that are used by the font
388 * package on a per application basis.
389 *
390 * Results:
391 * Stores a token in the mainPtr to hold information needed by this
392 * package on a per application basis.
393 *
394 * Side effects:
395 * Memory allocated.
396 *
397 *---------------------------------------------------------------------------
398 */
399 void
TkFontPkgInit(mainPtr)400 TkFontPkgInit(mainPtr)
401 TkMainInfo *mainPtr; /* The application being created. */
402 {
403 TkFontInfo *fiPtr;
404
405 fiPtr = (TkFontInfo *) ckalloc(sizeof(TkFontInfo));
406 Tcl_InitHashTable(&fiPtr->fontCache, TCL_STRING_KEYS);
407 Tcl_InitHashTable(&fiPtr->namedTable, TCL_STRING_KEYS);
408 fiPtr->mainPtr = mainPtr;
409 fiPtr->updatePending = 0;
410 mainPtr->fontInfoPtr = fiPtr;
411
412 TkpFontPkgInit(mainPtr);
413 }
414
415 /*
416 *---------------------------------------------------------------------------
417 *
418 * TkFontPkgFree --
419 *
420 * This procedure is called when an application is deleted. It
421 * deletes all the structures that were used by the font package
422 * for this application.
423 *
424 * Results:
425 * None.
426 *
427 * Side effects:
428 * Memory freed.
429 *
430 *---------------------------------------------------------------------------
431 */
432
433 void
TkFontPkgFree(mainPtr)434 TkFontPkgFree(mainPtr)
435 TkMainInfo *mainPtr; /* The application being deleted. */
436 {
437 TkFontInfo *fiPtr;
438 Tcl_HashEntry *hPtr, *searchPtr;
439 Tcl_HashSearch search;
440 int fontsLeft;
441
442 fiPtr = mainPtr->fontInfoPtr;
443
444 fontsLeft = 0;
445 for (searchPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
446 searchPtr != NULL;
447 searchPtr = Tcl_NextHashEntry(&search)) {
448 fontsLeft++;
449 fprintf(stderr, "Font %s still in cache.\n",
450 Tcl_GetHashKey(&fiPtr->fontCache, searchPtr));
451 }
452 #ifdef PURIFY
453 if (fontsLeft) {
454 panic("TkFontPkgFree: all fonts should have been freed already");
455 }
456 #endif
457 Tcl_DeleteHashTable(&fiPtr->fontCache);
458
459 hPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
460 while (hPtr != NULL) {
461 ckfree((char *) Tcl_GetHashValue(hPtr));
462 hPtr = Tcl_NextHashEntry(&search);
463 }
464 Tcl_DeleteHashTable(&fiPtr->namedTable);
465 if (fiPtr->updatePending != 0) {
466 Tcl_CancelIdleCall(TheWorldHasChanged, (ClientData) fiPtr);
467 }
468 ckfree((char *) fiPtr);
469 }
470
471 /*
472 *---------------------------------------------------------------------------
473 *
474 * Tk_FontObjCmd --
475 *
476 * This procedure is implemented to process the "font" Tcl command.
477 * See the user documentation for details on what it does.
478 *
479 * Results:
480 * A standard Tcl result.
481 *
482 * Side effects:
483 * See the user documentation.
484 *
485 *----------------------------------------------------------------------
486 */
487
488 int
Tk_FontObjCmd(clientData,interp,objc,objv)489 Tk_FontObjCmd(clientData, interp, objc, objv)
490 ClientData clientData; /* Main window associated with interpreter. */
491 Tcl_Interp *interp; /* Current interpreter. */
492 int objc; /* Number of arguments. */
493 Tcl_Obj *CONST objv[]; /* Argument objects. */
494 {
495 int index;
496 Tk_Window tkwin;
497 TkFontInfo *fiPtr;
498 static CONST char *optionStrings[] = {
499 "actual", "configure", "create", "delete",
500 "families", "measure", "metrics", "names",
501 "subfonts",
502 NULL
503 };
504 enum options {
505 FONT_ACTUAL, FONT_CONFIGURE, FONT_CREATE, FONT_DELETE,
506 FONT_FAMILIES, FONT_MEASURE, FONT_METRICS, FONT_NAMES,
507 FONT_SUBFONTS
508 };
509
510 tkwin = (Tk_Window) clientData;
511 fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
512
513 if (objc < 2) {
514 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg?");
515 return TCL_ERROR;
516 }
517 if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
518 &index) != TCL_OK) {
519 return TCL_ERROR;
520 }
521
522 switch ((enum options) index) {
523 case FONT_SUBFONTS: {
524 int skip;
525 Tk_Font tkfont;
526 Tcl_Obj *objPtr;
527 CONST TkFontAttributes *faPtr;
528
529 skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
530 if (skip < 0) {
531 return TCL_ERROR;
532 }
533 if ((objc < 3) || (objc - skip > 4)) {
534 Tcl_WrongNumArgs(interp, 2, objv,
535 "font ?-displayof window? ?option?");
536 return TCL_ERROR;
537 }
538 tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
539 if (tkfont == NULL) {
540 return TCL_ERROR;
541 }
542 TkpGetSubFonts(interp, tkfont);
543 Tk_FreeFont(tkfont);
544 return TCL_OK;
545 }
546 case FONT_ACTUAL: {
547 int skip, result;
548 Tk_Font tkfont;
549 Tcl_Obj *objPtr;
550 CONST TkFontAttributes *faPtr;
551
552 skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
553 if (skip < 0) {
554 return TCL_ERROR;
555 }
556 if ((objc < 3) || (objc - skip > 4)) {
557 Tcl_WrongNumArgs(interp, 2, objv,
558 "font ?-displayof window? ?option?");
559 return TCL_ERROR;
560 }
561 tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
562 if (tkfont == NULL) {
563 return TCL_ERROR;
564 }
565 objc -= skip;
566 objv += skip;
567 faPtr = GetFontAttributes(tkfont);
568 objPtr = NULL;
569 if (objc > 3) {
570 objPtr = objv[3];
571 }
572 result = GetAttributeInfoObj(interp, faPtr, objPtr);
573 Tk_FreeFont(tkfont);
574 return result;
575 }
576 case FONT_CONFIGURE: {
577 int result;
578 char *string;
579 Tcl_Obj *objPtr;
580 NamedFont *nfPtr;
581 Tcl_HashEntry *namedHashPtr;
582
583 if (objc < 3) {
584 Tcl_WrongNumArgs(interp, 2, objv, "fontname ?options?");
585 return TCL_ERROR;
586 }
587 string = Tcl_GetString(objv[2]);
588 namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
589 nfPtr = NULL; /* lint. */
590 if (namedHashPtr != NULL) {
591 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
592 }
593 if ((namedHashPtr == NULL) || (nfPtr->deletePending != 0)) {
594 Tcl_AppendResult(interp, "named font \"", string,
595 "\" doesn't exist", NULL);
596 return TCL_ERROR;
597 }
598 if (objc == 3) {
599 objPtr = NULL;
600 } else if (objc == 4) {
601 objPtr = objv[3];
602 } else {
603 result = ConfigAttributesObj(interp, tkwin, objc - 3,
604 objv + 3, &nfPtr->fa);
605 UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
606 return result;
607 }
608 return GetAttributeInfoObj(interp, &nfPtr->fa, objPtr);
609 }
610 case FONT_CREATE: {
611 int skip, i;
612 char *name;
613 char buf[16 + TCL_INTEGER_SPACE];
614 TkFontAttributes fa;
615 Tcl_HashEntry *namedHashPtr;
616
617 skip = 3;
618 if (objc < 3) {
619 name = NULL;
620 } else {
621 name = Tcl_GetString(objv[2]);
622 if (name[0] == '-') {
623 name = NULL;
624 }
625 }
626 if (name == NULL) {
627 /*
628 * No font name specified. Generate one of the form "fontX".
629 */
630
631 for (i = 1; ; i++) {
632 sprintf(buf, "font%d", i);
633 namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, buf);
634 if (namedHashPtr == NULL) {
635 break;
636 }
637 }
638 name = buf;
639 skip = 2;
640 }
641 TkInitFontAttributes(&fa);
642 if (ConfigAttributesObj(interp, tkwin, objc - skip, objv + skip,
643 &fa) != TCL_OK) {
644 return TCL_ERROR;
645 }
646 if (CreateNamedFont(interp, tkwin, name, &fa) != TCL_OK) {
647 return TCL_ERROR;
648 }
649 Tcl_SetObjResult(interp, LangFontObj( interp, NULL, name));
650 break;
651 }
652 case FONT_DELETE: {
653 int i;
654 char *string;
655 NamedFont *nfPtr;
656 Tcl_HashEntry *namedHashPtr;
657
658 /*
659 * Delete the named font. If there are still widgets using this
660 * font, then it isn't deleted right away.
661 */
662
663 if (objc < 3) {
664 Tcl_WrongNumArgs(interp, 2, objv, "fontname ?fontname ...?");
665 return TCL_ERROR;
666 }
667 for (i = 2; i < objc; i++) {
668 string = Tcl_GetString(objv[i]);
669 namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable, string);
670 if (namedHashPtr == NULL) {
671 Tcl_AppendResult(interp, "named font \"", string,
672 "\" doesn't exist", (char *) NULL);
673 return TCL_ERROR;
674 }
675 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
676 if (nfPtr->refCount != 0) {
677 nfPtr->deletePending = 1;
678 } else {
679 Tcl_DeleteHashEntry(namedHashPtr);
680 ckfree((char *) nfPtr);
681 }
682 }
683 break;
684 }
685 case FONT_FAMILIES: {
686 int skip;
687
688 skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
689 if (skip < 0) {
690 return TCL_ERROR;
691 }
692 if (objc - skip != 2) {
693 Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
694 return TCL_ERROR;
695 }
696 TkpGetFontFamilies(interp, tkwin);
697 break;
698 }
699 case FONT_MEASURE: {
700 char *string;
701 Tk_Font tkfont;
702 int length, skip;
703 Tcl_Obj *resultPtr;
704
705 skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
706 if (skip < 0) {
707 return TCL_ERROR;
708 }
709 if (objc - skip != 4) {
710 Tcl_WrongNumArgs(interp, 2, objv,
711 "font ?-displayof window? text");
712 return TCL_ERROR;
713 }
714 tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
715 if (tkfont == NULL) {
716 return TCL_ERROR;
717 }
718 string = Tcl_GetStringFromObj(objv[3 + skip], &length);
719 resultPtr = Tcl_GetObjResult(interp);
720 Tcl_SetIntObj(resultPtr, Tk_TextWidth(tkfont, string, length));
721 Tk_FreeFont(tkfont);
722 break;
723 }
724 case FONT_METRICS: {
725 Tk_Font tkfont;
726 int skip, index, i;
727 CONST TkFontMetrics *fmPtr;
728 static CONST char *switches[] = {
729 "-ascent", "-descent", "-linespace", "-fixed", NULL
730 };
731
732 skip = TkGetDisplayOf(interp, objc - 3, objv + 3, &tkwin);
733 if (skip < 0) {
734 return TCL_ERROR;
735 }
736 if ((objc < 3) || ((objc - skip) > 4)) {
737 Tcl_WrongNumArgs(interp, 2, objv,
738 "font ?-displayof window? ?option?");
739 return TCL_ERROR;
740 }
741 tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);
742 if (tkfont == NULL) {
743 return TCL_ERROR;
744 }
745 objc -= skip;
746 objv += skip;
747 fmPtr = GetFontMetrics(tkfont);
748 if (objc == 3) {
749 Tcl_AppendElement(interp, "-ascent");
750 Tcl_IntResults(interp, 1, 1, fmPtr->ascent);
751 Tcl_AppendElement(interp, "-descent");
752 Tcl_IntResults(interp, 1, 1, fmPtr->descent);
753 Tcl_AppendElement(interp, "-linespace");
754 Tcl_IntResults(interp, 1, 1, fmPtr->ascent + fmPtr->descent);
755 Tcl_AppendElement(interp, "-fixed");
756 Tcl_IntResults(interp, 1, 1, fmPtr->fixed);
757 } else {
758 if (Tcl_GetIndexFromObj(interp, objv[3], switches,
759 "metric", 0, &index) != TCL_OK) {
760 Tk_FreeFont(tkfont);
761 return TCL_ERROR;
762 }
763 i = 0; /* Needed only to prevent compiler
764 * warning. */
765 switch (index) {
766 case 0: i = fmPtr->ascent; break;
767 case 1: i = fmPtr->descent; break;
768 case 2: i = fmPtr->ascent + fmPtr->descent; break;
769 case 3: i = fmPtr->fixed; break;
770 }
771 Tcl_SetIntObj(Tcl_GetObjResult(interp), i);
772 }
773 Tk_FreeFont(tkfont);
774 break;
775 }
776 case FONT_NAMES: {
777 char *string;
778 NamedFont *nfPtr;
779 Tcl_HashSearch search;
780 Tcl_HashEntry *namedHashPtr;
781 Tcl_Obj *strPtr, *resultPtr;
782
783 if (objc != 2) {
784 Tcl_WrongNumArgs(interp, 1, objv, "names");
785 return TCL_ERROR;
786 }
787 resultPtr = Tcl_GetObjResult(interp);
788 namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
789 while (namedHashPtr != NULL) {
790 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
791 if (nfPtr->deletePending == 0) {
792 string = Tcl_GetHashKey(&fiPtr->namedTable, namedHashPtr);
793 strPtr = LangFontObj(interp, NULL, string);
794 Tcl_ListObjAppendElement(interp, resultPtr, strPtr);
795 }
796 namedHashPtr = Tcl_NextHashEntry(&search);
797 }
798 break;
799 }
800 }
801 return TCL_OK;
802 }
803
804 /*
805 *---------------------------------------------------------------------------
806 *
807 * UpdateDependentFonts, TheWorldHasChanged, RecomputeWidgets --
808 *
809 * Called when the attributes of a named font changes. Updates all
810 * the instantiated fonts that depend on that named font and then
811 * uses the brute force approach and prepares every widget to
812 * recompute its geometry.
813 *
814 * Results:
815 * None.
816 *
817 * Side effects:
818 * Things get queued for redisplay.
819 *
820 *---------------------------------------------------------------------------
821 */
822
823 static void
UpdateDependentFonts(fiPtr,tkwin,namedHashPtr)824 UpdateDependentFonts(fiPtr, tkwin, namedHashPtr)
825 TkFontInfo *fiPtr; /* Info about application's fonts. */
826 Tk_Window tkwin; /* A window in the application. */
827 Tcl_HashEntry *namedHashPtr;/* The named font that is changing. */
828 {
829 Tcl_HashEntry *cacheHashPtr;
830 Tcl_HashSearch search;
831 TkFont *fontPtr;
832 NamedFont *nfPtr;
833
834 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
835 if (nfPtr->refCount == 0) {
836 /*
837 * Well nobody's using this named font, so don't have to tell
838 * any widgets to recompute themselves.
839 */
840
841 return;
842 }
843
844 cacheHashPtr = Tcl_FirstHashEntry(&fiPtr->fontCache, &search);
845 while (cacheHashPtr != NULL) {
846 for (fontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
847 fontPtr != NULL; fontPtr = fontPtr->nextPtr) {
848 if (fontPtr->namedHashPtr == namedHashPtr) {
849 TkpGetFontFromAttributes(fontPtr, tkwin, &nfPtr->fa);
850 if (fiPtr->updatePending == 0) {
851 fiPtr->updatePending = 1;
852 Tcl_DoWhenIdle(TheWorldHasChanged, (ClientData) fiPtr);
853 }
854 }
855 }
856 cacheHashPtr = Tcl_NextHashEntry(&search);
857 }
858 }
859
860 static void
TheWorldHasChanged(clientData)861 TheWorldHasChanged(clientData)
862 ClientData clientData; /* Info about application's fonts. */
863 {
864 TkFontInfo *fiPtr;
865
866 fiPtr = (TkFontInfo *) clientData;
867 fiPtr->updatePending = 0;
868
869 RecomputeWidgets(fiPtr->mainPtr->winPtr);
870 }
871
872 static void
RecomputeWidgets(winPtr)873 RecomputeWidgets(winPtr)
874 TkWindow *winPtr; /* Window to which command is sent. */
875 {
876 Tk_ClassWorldChangedProc *proc;
877 proc = Tk_GetClassProc(winPtr->classProcsPtr, worldChangedProc);
878 if (proc != NULL) {
879 (*proc)(winPtr->instanceData);
880 }
881
882 /*
883 * Notify all the descendants of this window that the world has changed.
884 *
885 * This could be done recursively or iteratively. The recursive version
886 * is easier to implement and understand, and typically, windows with a
887 * -font option will be leaf nodes in the widget heirarchy (buttons,
888 * labels, etc.), so the recursion depth will be shallow.
889 *
890 * However, the additional overhead of the recursive calls may become
891 * a performance problem if typical usage alters such that -font'ed widgets
892 * appear high in the heirarchy, causing deep recursion. This could happen
893 * with text widgets, or more likely with the (not yet existant) labeled
894 * frame widget. With these widgets it is possible, even likely, that a
895 * -font'ed widget (text or labeled frame) will not be a leaf node, but
896 * will instead have many descendants. If this is ever found to cause
897 * a performance problem, it may be worth investigating an iterative
898 * version of the code below.
899 */
900 for (winPtr = winPtr->childList; winPtr != NULL; winPtr = winPtr->nextPtr) {
901 RecomputeWidgets(winPtr);
902 }
903 }
904
905 /*
906 *---------------------------------------------------------------------------
907 *
908 * CreateNamedFont --
909 *
910 * Create the specified named font with the given attributes in the
911 * named font table associated with the interp.
912 *
913 * Results:
914 * Returns TCL_OK if the font was successfully created, or TCL_ERROR
915 * if the named font already existed. If TCL_ERROR is returned, an
916 * error message is left in the interp's result.
917 *
918 * Side effects:
919 * Assume there used to exist a named font by the specified name, and
920 * that the named font had been deleted, but there were still some
921 * widgets using the named font at the time it was deleted. If a
922 * new named font is created with the same name, all those widgets
923 * that were using the old named font will be redisplayed using
924 * the new named font's attributes.
925 *
926 *---------------------------------------------------------------------------
927 */
928
929 static int
CreateNamedFont(interp,tkwin,name,faPtr)930 CreateNamedFont(interp, tkwin, name, faPtr)
931 Tcl_Interp *interp; /* Interp for error return. */
932 Tk_Window tkwin; /* A window associated with interp. */
933 CONST char *name; /* Name for the new named font. */
934 TkFontAttributes *faPtr; /* Attributes for the new named font. */
935 {
936 TkFontInfo *fiPtr;
937 Tcl_HashEntry *namedHashPtr;
938 int new;
939 NamedFont *nfPtr;
940
941 fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
942
943 namedHashPtr = Tcl_CreateHashEntry(&fiPtr->namedTable, name, &new);
944
945 if (new == 0) {
946 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
947 if (nfPtr->deletePending == 0) {
948 Tcl_ResetResult(interp);
949 Tcl_AppendResult(interp, "named font \"", name,
950 "\" already exists", (char *) NULL);
951 return TCL_ERROR;
952 }
953
954 /*
955 * Recreating a named font with the same name as a previous
956 * named font. Some widgets were still using that named
957 * font, so they need to get redisplayed.
958 */
959
960 nfPtr->fa = *faPtr;
961 nfPtr->deletePending = 0;
962 UpdateDependentFonts(fiPtr, tkwin, namedHashPtr);
963 return TCL_OK;
964 }
965
966 nfPtr = (NamedFont *) ckalloc(sizeof(NamedFont));
967 nfPtr->fa = *faPtr;
968 nfPtr->refCount = 0;
969 nfPtr->deletePending = 0;
970 Tcl_SetHashValue(namedHashPtr, nfPtr);
971 return TCL_OK;
972 }
973
974 /*
975 *---------------------------------------------------------------------------
976 *
977 * Tk_GetFont --
978 *
979 * Given a string description of a font, map the description to a
980 * corresponding Tk_Font that represents the font.
981 *
982 * Results:
983 * The return value is token for the font, or NULL if an error
984 * prevented the font from being created. If NULL is returned, an
985 * error message will be left in the interp's result.
986 *
987 * Side effects:
988 * The font is added to an internal database with a reference
989 * count. For each call to this procedure, there should eventually
990 * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
991 * database is cleaned up when fonts aren't in use anymore.
992 *
993 *---------------------------------------------------------------------------
994 */
995
996 Tk_Font
Tk_GetFont(interp,tkwin,string)997 Tk_GetFont(interp, tkwin, string)
998 Tcl_Interp *interp; /* Interp for database and error return. */
999 Tk_Window tkwin; /* For display on which font will be used. */
1000 CONST char *string; /* String describing font, as: named font,
1001 * native format, or parseable string. */
1002 {
1003 Tk_Font tkfont;
1004 Tcl_Obj *strPtr;
1005
1006 strPtr = Tcl_NewStringObj((char *) string, -1);
1007 Tcl_IncrRefCount(strPtr);
1008 tkfont = Tk_AllocFontFromObj(interp, tkwin, strPtr);
1009 Tcl_DecrRefCount(strPtr);
1010 return tkfont;
1011 }
1012
1013 /*
1014 *---------------------------------------------------------------------------
1015 *
1016 * Tk_AllocFontFromObj --
1017 *
1018 * Given a string description of a font, map the description to a
1019 * corresponding Tk_Font that represents the font.
1020 *
1021 * Results:
1022 * The return value is token for the font, or NULL if an error
1023 * prevented the font from being created. If NULL is returned, an
1024 * error message will be left in interp's result object.
1025 *
1026 * Side effects:
1027 * The font is added to an internal database with a reference
1028 * count. For each call to this procedure, there should eventually
1029 * be a call to Tk_FreeFont() or Tk_FreeFontFromObj() so that the
1030 * database is cleaned up when fonts aren't in use anymore.
1031 *
1032 *---------------------------------------------------------------------------
1033 */
1034
1035 Tk_Font
Tk_AllocFontFromObj(interp,tkwin,objPtr)1036 Tk_AllocFontFromObj(interp, tkwin, objPtr)
1037 Tcl_Interp *interp; /* Interp for database and error return. */
1038 Tk_Window tkwin; /* For screen on which font will be used. */
1039 Tcl_Obj *objPtr; /* Object describing font, as: named font,
1040 * native format, or parseable string. */
1041 {
1042 TkFontInfo *fiPtr;
1043 Tcl_HashEntry *cacheHashPtr, *namedHashPtr;
1044 TkFont *fontPtr, *firstFontPtr, *oldFontPtr;
1045 int new, descent;
1046 NamedFont *nfPtr;
1047
1048 fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
1049 if (objPtr->typePtr != &tkFontObjType) {
1050 SetFontFromAny(interp, objPtr);
1051 }
1052
1053 oldFontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
1054
1055 if (oldFontPtr != NULL) {
1056 if (oldFontPtr->resourceRefCount == 0) {
1057 /*
1058 * This is a stale reference: it refers to a TkFont that's
1059 * no longer in use. Clear the reference.
1060 */
1061
1062 FreeFontObjProc(objPtr);
1063 oldFontPtr = NULL;
1064 } else if (Tk_Screen(tkwin) == oldFontPtr->screen) {
1065 oldFontPtr->resourceRefCount++;
1066 return (Tk_Font) oldFontPtr;
1067 }
1068 }
1069
1070 /*
1071 * Next, search the list of fonts that have the name we want, to see
1072 * if one of them is for the right screen.
1073 */
1074
1075 new = 0;
1076 if (oldFontPtr != NULL) {
1077 cacheHashPtr = oldFontPtr->cacheHashPtr;
1078 FreeFontObjProc(objPtr);
1079 } else {
1080 cacheHashPtr = Tcl_CreateHashEntry(&fiPtr->fontCache,
1081 Tcl_GetString(objPtr), &new);
1082 }
1083 firstFontPtr = (TkFont *) Tcl_GetHashValue(cacheHashPtr);
1084 for (fontPtr = firstFontPtr; (fontPtr != NULL);
1085 fontPtr = fontPtr->nextPtr) {
1086 if (Tk_Screen(tkwin) == fontPtr->screen) {
1087 fontPtr->resourceRefCount++;
1088 fontPtr->objRefCount++;
1089 objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
1090 return (Tk_Font) fontPtr;
1091 }
1092 }
1093
1094 /*
1095 * The desired font isn't in the table. Make a new one.
1096 */
1097
1098 namedHashPtr = Tcl_FindHashEntry(&fiPtr->namedTable,
1099 Tcl_GetString(objPtr));
1100 if (namedHashPtr != NULL) {
1101 /*
1102 * Construct a font based on a named font.
1103 */
1104
1105 nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
1106 nfPtr->refCount++;
1107
1108 fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &nfPtr->fa);
1109 } else {
1110 /*
1111 * Native font?
1112 */
1113
1114 fontPtr = TkpGetNativeFont(tkwin, Tcl_GetString(objPtr));
1115 if (fontPtr == NULL) {
1116 TkFontAttributes fa;
1117 Tcl_Obj *dupObjPtr = Tcl_DuplicateObj(objPtr);
1118
1119 if (ParseFontNameObj(interp, tkwin, dupObjPtr, &fa) != TCL_OK) {
1120 if (new) {
1121 Tcl_DeleteHashEntry(cacheHashPtr);
1122 }
1123 Tcl_DecrRefCount(dupObjPtr);
1124 return NULL;
1125 }
1126 Tcl_DecrRefCount(dupObjPtr);
1127
1128 /*
1129 * String contained the attributes inline.
1130 */
1131
1132 fontPtr = TkpGetFontFromAttributes(NULL, tkwin, &fa);
1133 }
1134 }
1135
1136 /*
1137 * Detect the system font engine going wrong and fail more gracefully.
1138 */
1139
1140 if (fontPtr == NULL) {
1141 if (new) {
1142 Tcl_DeleteHashEntry(cacheHashPtr);
1143 }
1144 Tcl_SetObjResult(interp, Tcl_NewStringObj(
1145 "failed to allocate font due to internal system font engine"
1146 " problem", -1));
1147 return NULL;
1148 }
1149
1150 fontPtr->resourceRefCount = 1;
1151 fontPtr->objRefCount = 1;
1152 fontPtr->cacheHashPtr = cacheHashPtr;
1153 fontPtr->namedHashPtr = namedHashPtr;
1154 fontPtr->screen = Tk_Screen(tkwin);
1155 fontPtr->nextPtr = firstFontPtr;
1156 Tcl_SetHashValue(cacheHashPtr, fontPtr);
1157
1158 Tk_MeasureChars((Tk_Font) fontPtr, "0", 1, -1, 0, &fontPtr->tabWidth);
1159 if (fontPtr->tabWidth == 0) {
1160 fontPtr->tabWidth = fontPtr->fm.maxWidth;
1161 }
1162 fontPtr->tabWidth *= 8;
1163
1164 /*
1165 * Make sure the tab width isn't zero (some fonts may not have enough
1166 * information to set a reasonable tab width).
1167 */
1168
1169 if (fontPtr->tabWidth == 0) {
1170 fontPtr->tabWidth = 1;
1171 }
1172
1173 /*
1174 * Get information used for drawing underlines in generic code on a
1175 * non-underlined font.
1176 */
1177
1178 descent = fontPtr->fm.descent;
1179 fontPtr->underlinePos = descent / 2;
1180 fontPtr->underlineHeight = TkFontGetPixels(Tk_Screen(tkwin), fontPtr->fa.size) / 10;
1181 if (fontPtr->underlineHeight == 0) {
1182 fontPtr->underlineHeight = 1;
1183 }
1184 if (fontPtr->underlinePos + fontPtr->underlineHeight > descent) {
1185 /*
1186 * If this set of values would cause the bottom of the underline
1187 * bar to stick below the descent of the font, jack the underline
1188 * up a bit higher.
1189 */
1190
1191 fontPtr->underlineHeight = descent - fontPtr->underlinePos;
1192 if (fontPtr->underlineHeight == 0) {
1193 fontPtr->underlinePos--;
1194 fontPtr->underlineHeight = 1;
1195 }
1196 }
1197
1198 objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
1199 return (Tk_Font) fontPtr;
1200 }
1201
1202 /*
1203 *----------------------------------------------------------------------
1204 *
1205 * Tk_GetFontFromObj --
1206 *
1207 * Find the font that corresponds to a given object. The font must
1208 * have already been created by Tk_GetFont or Tk_AllocFontFromObj.
1209 *
1210 * Results:
1211 * The return value is a token for the font that matches objPtr
1212 * and is suitable for use in tkwin.
1213 *
1214 * Side effects:
1215 * If the object is not already a font ref, the conversion will free
1216 * any old internal representation.
1217 *
1218 *----------------------------------------------------------------------
1219 */
1220
1221 Tk_Font
Tk_GetFontFromObj(tkwin,objPtr)1222 Tk_GetFontFromObj(tkwin, objPtr)
1223 Tk_Window tkwin; /* The window that the font will be used in. */
1224 Tcl_Obj *objPtr; /* The object from which to get the font. */
1225 {
1226 TkFontInfo *fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
1227 TkFont *fontPtr;
1228 Tcl_HashEntry *hashPtr;
1229
1230 if (objPtr->typePtr != &tkFontObjType) {
1231 SetFontFromAny((Tcl_Interp *) NULL, objPtr);
1232 }
1233
1234 fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
1235
1236 if (fontPtr != NULL) {
1237 if (fontPtr->resourceRefCount == 0) {
1238 /*
1239 * This is a stale reference: it refers to a TkFont that's
1240 * no longer in use. Clear the reference.
1241 */
1242
1243 FreeFontObjProc(objPtr);
1244 fontPtr = NULL;
1245 } else if (Tk_Screen(tkwin) == fontPtr->screen) {
1246 return (Tk_Font) fontPtr;
1247 }
1248 }
1249
1250 /*
1251 * Next, search the list of fonts that have the name we want, to see
1252 * if one of them is for the right screen.
1253 */
1254
1255 if (fontPtr != NULL) {
1256 hashPtr = fontPtr->cacheHashPtr;
1257 FreeFontObjProc(objPtr);
1258 } else {
1259 hashPtr = Tcl_FindHashEntry(&fiPtr->fontCache, Tcl_GetString(objPtr));
1260 }
1261 if (hashPtr != NULL) {
1262 for (fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr); fontPtr != NULL;
1263 fontPtr = fontPtr->nextPtr) {
1264 if (Tk_Screen(tkwin) == fontPtr->screen) {
1265 fontPtr->objRefCount++;
1266 objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
1267 return (Tk_Font) fontPtr;
1268 }
1269 }
1270 }
1271
1272 panic("Tk_GetFontFromObj called with non-existent font!");
1273 return NULL;
1274 }
1275
1276 /*
1277 *----------------------------------------------------------------------
1278 *
1279 * SetFontFromAny --
1280 *
1281 * Convert the internal representation of a Tcl object to the
1282 * font internal form.
1283 *
1284 * Results:
1285 * Always returns TCL_OK.
1286 *
1287 * Side effects:
1288 * The object is left with its typePtr pointing to tkFontObjType.
1289 * The TkFont pointer is NULL.
1290 *
1291 *----------------------------------------------------------------------
1292 */
1293
1294 static int
SetFontFromAny(interp,objPtr)1295 SetFontFromAny(interp, objPtr)
1296 Tcl_Interp *interp; /* Used for error reporting if not NULL. */
1297 Tcl_Obj *objPtr; /* The object to convert. */
1298 {
1299 Tcl_ObjType *typePtr;
1300
1301 /*
1302 * Free the old internalRep before setting the new one.
1303 */
1304
1305 Tcl_GetString(objPtr);
1306 typePtr = objPtr->typePtr;
1307 if ((typePtr != NULL) && (typePtr->freeIntRepProc != NULL)) {
1308 (*typePtr->freeIntRepProc)(objPtr);
1309 }
1310 TclObjSetType(objPtr,&tkFontObjType);
1311 objPtr->internalRep.twoPtrValue.ptr1 = NULL;
1312
1313 return TCL_OK;
1314 }
1315
1316 /*
1317 *---------------------------------------------------------------------------
1318 *
1319 * Tk_NameOfFont --
1320 *
1321 * Given a font, return a textual string identifying it.
1322 *
1323 * Results:
1324 * The return value is the description that was passed to
1325 * Tk_GetFont() to create the font. The storage for the returned
1326 * string is only guaranteed to persist until the font is deleted.
1327 * The caller should not modify this string.
1328 *
1329 * Side effects:
1330 * None.
1331 *
1332 *---------------------------------------------------------------------------
1333 */
1334
1335 CONST char *
Tk_NameOfFont(tkfont)1336 Tk_NameOfFont(tkfont)
1337 Tk_Font tkfont; /* Font whose name is desired. */
1338 {
1339 TkFont *fontPtr;
1340
1341 fontPtr = (TkFont *) tkfont;
1342 return fontPtr->cacheHashPtr->key.string;
1343 }
1344
1345 /*
1346 *---------------------------------------------------------------------------
1347 *
1348 * Tk_FreeFont --
1349 *
1350 * Called to release a font allocated by Tk_GetFont().
1351 *
1352 * Results:
1353 * None.
1354 *
1355 * Side effects:
1356 * The reference count associated with font is decremented, and
1357 * only deallocated when no one is using it.
1358 *
1359 *---------------------------------------------------------------------------
1360 */
1361
1362 void
Tk_FreeFont(tkfont)1363 Tk_FreeFont(tkfont)
1364 Tk_Font tkfont; /* Font to be released. */
1365 {
1366 TkFont *fontPtr, *prevPtr;
1367 NamedFont *nfPtr;
1368
1369 if (tkfont == NULL) {
1370 return;
1371 }
1372 fontPtr = (TkFont *) tkfont;
1373 fontPtr->resourceRefCount--;
1374 if (fontPtr->resourceRefCount > 0) {
1375 return;
1376 }
1377 if (fontPtr->namedHashPtr != NULL) {
1378 /*
1379 * This font derived from a named font. Reduce the reference
1380 * count on the named font and free it if no-one else is
1381 * using it.
1382 */
1383
1384 nfPtr = (NamedFont *) Tcl_GetHashValue(fontPtr->namedHashPtr);
1385 nfPtr->refCount--;
1386 if ((nfPtr->refCount == 0) && (nfPtr->deletePending != 0)) {
1387 Tcl_DeleteHashEntry(fontPtr->namedHashPtr);
1388 ckfree((char *) nfPtr);
1389 }
1390 }
1391
1392 prevPtr = (TkFont *) Tcl_GetHashValue(fontPtr->cacheHashPtr);
1393 if (prevPtr == fontPtr) {
1394 if (fontPtr->nextPtr == NULL) {
1395 Tcl_DeleteHashEntry(fontPtr->cacheHashPtr);
1396 } else {
1397 Tcl_SetHashValue(fontPtr->cacheHashPtr, fontPtr->nextPtr);
1398 }
1399 } else {
1400 while (prevPtr->nextPtr != fontPtr) {
1401 prevPtr = prevPtr->nextPtr;
1402 }
1403 prevPtr->nextPtr = fontPtr->nextPtr;
1404 }
1405
1406 TkpDeleteFont(fontPtr);
1407 if (fontPtr->objRefCount == 0) {
1408 ckfree((char *) fontPtr);
1409 }
1410 }
1411
1412 /*
1413 *---------------------------------------------------------------------------
1414 *
1415 * Tk_FreeFontFromObj --
1416 *
1417 * Called to release a font inside a Tcl_Obj *. Decrements the refCount
1418 * of the font and removes it from the hash tables if necessary.
1419 *
1420 * Results:
1421 * None.
1422 *
1423 * Side effects:
1424 * The reference count associated with font is decremented, and
1425 * only deallocated when no one is using it.
1426 *
1427 *---------------------------------------------------------------------------
1428 */
1429
1430 void
Tk_FreeFontFromObj(tkwin,objPtr)1431 Tk_FreeFontFromObj(tkwin, objPtr)
1432 Tk_Window tkwin; /* The window this font lives in. Needed
1433 * for the screen value. */
1434 Tcl_Obj *objPtr; /* The Tcl_Obj * to be freed. */
1435 {
1436 Tk_FreeFont(Tk_GetFontFromObj(tkwin, objPtr));
1437 }
1438
1439 /*
1440 *---------------------------------------------------------------------------
1441 *
1442 * FreeFontObjProc --
1443 *
1444 * This proc is called to release an object reference to a font.
1445 * Called when the object's internal rep is released or when
1446 * the cached fontPtr needs to be changed.
1447 *
1448 * Results:
1449 * None.
1450 *
1451 * Side effects:
1452 * The object reference count is decremented. When both it
1453 * and the hash ref count go to zero, the font's resources
1454 * are released.
1455 *
1456 *---------------------------------------------------------------------------
1457 */
1458
1459 static void
FreeFontObjProc(objPtr)1460 FreeFontObjProc(objPtr)
1461 Tcl_Obj *objPtr; /* The object we are releasing. */
1462 {
1463 TkFont *fontPtr = (TkFont *) objPtr->internalRep.twoPtrValue.ptr1;
1464
1465 if (fontPtr != NULL) {
1466 fontPtr->objRefCount--;
1467 if ((fontPtr->resourceRefCount == 0) && (fontPtr->objRefCount == 0)) {
1468 ckfree((char *) fontPtr);
1469 objPtr->internalRep.twoPtrValue.ptr1 = NULL;
1470 }
1471 }
1472 }
1473
1474 /*
1475 *---------------------------------------------------------------------------
1476 *
1477 * DupFontObjProc --
1478 *
1479 * When a cached font object is duplicated, this is called to
1480 * update the internal reps.
1481 *
1482 * Results:
1483 * None.
1484 *
1485 * Side effects:
1486 * The font's objRefCount is incremented and the internal rep
1487 * of the copy is set to point to it.
1488 *
1489 *---------------------------------------------------------------------------
1490 */
1491
1492 static void
DupFontObjProc(srcObjPtr,dupObjPtr)1493 DupFontObjProc(srcObjPtr, dupObjPtr)
1494 Tcl_Obj *srcObjPtr; /* The object we are copying from. */
1495 Tcl_Obj *dupObjPtr; /* The object we are copying to. */
1496 {
1497 TkFont *fontPtr = (TkFont *) srcObjPtr->internalRep.twoPtrValue.ptr1;
1498
1499 dupObjPtr->typePtr = srcObjPtr->typePtr;
1500 dupObjPtr->internalRep.twoPtrValue.ptr1 = (VOID *) fontPtr;
1501
1502 if (fontPtr != NULL) {
1503 fontPtr->objRefCount++;
1504 }
1505 }
1506
1507 /*
1508 *---------------------------------------------------------------------------
1509 *
1510 * Tk_FontId --
1511 *
1512 * Given a font, return an opaque handle that should be selected
1513 * into the XGCValues structure in order to get the constructed
1514 * gc to use this font. This procedure would go away if the
1515 * XGCValues structure were replaced with a TkGCValues structure.
1516 *
1517 * Results:
1518 * As above.
1519 *
1520 * Side effects:
1521 * None.
1522 *
1523 *---------------------------------------------------------------------------
1524 */
1525
1526 Font
Tk_FontId(tkfont)1527 Tk_FontId(tkfont)
1528 Tk_Font tkfont; /* Font that is going to be selected into GC. */
1529 {
1530 TkFont *fontPtr;
1531
1532 fontPtr = (TkFont *) tkfont;
1533 return fontPtr->fid;
1534 }
1535
1536 /*
1537 *---------------------------------------------------------------------------
1538 *
1539 * Tk_GetFontMetrics --
1540 *
1541 * Returns overall ascent and descent metrics for the given font.
1542 * These values can be used to space multiple lines of text and
1543 * to align the baselines of text in different fonts.
1544 *
1545 * Results:
1546 * If *heightPtr is non-NULL, it is filled with the overall height
1547 * of the font, which is the sum of the ascent and descent.
1548 * If *ascentPtr or *descentPtr is non-NULL, they are filled with
1549 * the ascent and/or descent information for the font.
1550 *
1551 * Side effects:
1552 * None.
1553 *
1554 *---------------------------------------------------------------------------
1555 */
1556 void
Tk_GetFontMetrics(tkfont,fmPtr)1557 Tk_GetFontMetrics(tkfont, fmPtr)
1558 Tk_Font tkfont; /* Font in which metrics are calculated. */
1559 Tk_FontMetrics *fmPtr; /* Pointer to structure in which font
1560 * metrics for tkfont will be stored. */
1561 {
1562 TkFont *fontPtr;
1563
1564 fontPtr = (TkFont *) tkfont;
1565 fmPtr->ascent = fontPtr->fm.ascent;
1566 fmPtr->descent = fontPtr->fm.descent;
1567 fmPtr->linespace = fontPtr->fm.ascent + fontPtr->fm.descent;
1568 }
1569
1570 /*
1571 *---------------------------------------------------------------------------
1572 *
1573 * Tk_PostscriptFontName --
1574 *
1575 * Given a Tk_Font, return the name of the corresponding Postscript
1576 * font.
1577 *
1578 * Results:
1579 * The return value is the pointsize of the given Tk_Font.
1580 * The name of the Postscript font is appended to dsPtr.
1581 *
1582 * Side effects:
1583 * If the font does not exist on the printer, the print job will
1584 * fail at print time. Given a "reasonable" Postscript printer,
1585 * the following Tk_Font font families should print correctly:
1586 *
1587 * Avant Garde, Arial, Bookman, Courier, Courier New, Geneva,
1588 * Helvetica, Monaco, New Century Schoolbook, New York,
1589 * Palatino, Symbol, Times, Times New Roman, Zapf Chancery,
1590 * and Zapf Dingbats.
1591 *
1592 * Any other Tk_Font font families may not print correctly
1593 * because the computed Postscript font name may be incorrect.
1594 *
1595 *---------------------------------------------------------------------------
1596 */
1597
1598 int
Tk_PostscriptFontName(tkfont,dsPtr)1599 Tk_PostscriptFontName(tkfont, dsPtr)
1600 Tk_Font tkfont; /* Font in which text will be printed. */
1601 Tcl_DString *dsPtr; /* Pointer to an initialized Tcl_DString to
1602 * which the name of the Postscript font that
1603 * corresponds to tkfont will be appended. */
1604 {
1605 TkFont *fontPtr;
1606 Tk_Uid family, weightString, slantString;
1607 char *src, *dest;
1608 int upper, len;
1609
1610 len = Tcl_DStringLength(dsPtr);
1611 fontPtr = (TkFont *) tkfont;
1612
1613 /*
1614 * Convert the case-insensitive Tk_Font family name to the
1615 * case-sensitive Postscript family name. Take out any spaces and
1616 * capitalize the first letter of each word.
1617 */
1618
1619 family = fontPtr->fa.family;
1620 if (strncasecmp(family, "itc ", 4) == 0) {
1621 family = family + 4;
1622 }
1623 if ((strcasecmp(family, "Arial") == 0)
1624 || (strcasecmp(family, "Geneva") == 0)) {
1625 family = "Helvetica";
1626 } else if ((strcasecmp(family, "Times New Roman") == 0)
1627 || (strcasecmp(family, "New York") == 0)) {
1628 family = "Times";
1629 } else if ((strcasecmp(family, "Courier New") == 0)
1630 || (strcasecmp(family, "Monaco") == 0)) {
1631 family = "Courier";
1632 } else if (strcasecmp(family, "AvantGarde") == 0) {
1633 family = "AvantGarde";
1634 } else if (strcasecmp(family, "ZapfChancery") == 0) {
1635 family = "ZapfChancery";
1636 } else if (strcasecmp(family, "ZapfDingbats") == 0) {
1637 family = "ZapfDingbats";
1638 } else {
1639 Tcl_UniChar ch;
1640
1641 /*
1642 * Inline, capitalize the first letter of each word, lowercase the
1643 * rest of the letters in each word, and then take out the spaces
1644 * between the words. This may make the DString shorter, which is
1645 * safe to do.
1646 */
1647
1648 Tcl_DStringAppend(dsPtr, family, -1);
1649
1650 src = dest = Tcl_DStringValue(dsPtr) + len;
1651 upper = 1;
1652 for (; *src != '\0'; ) {
1653 while (isspace(UCHAR(*src))) { /* INTL: ISO space */
1654 src++;
1655 upper = 1;
1656 }
1657 src += Tcl_UtfToUniChar(src, &ch);
1658 if (upper) {
1659 ch = Tcl_UniCharToUpper(ch);
1660 upper = 0;
1661 } else {
1662 ch = Tcl_UniCharToLower(ch);
1663 }
1664 dest += Tcl_UniCharToUtf(ch, dest);
1665 }
1666 *dest = '\0';
1667 Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
1668 family = Tcl_DStringValue(dsPtr) + len;
1669 }
1670 if (family != Tcl_DStringValue(dsPtr) + len) {
1671 Tcl_DStringAppend(dsPtr, family, -1);
1672 family = Tcl_DStringValue(dsPtr) + len;
1673 }
1674
1675 if (strcasecmp(family, "NewCenturySchoolbook") == 0) {
1676 Tcl_DStringSetLength(dsPtr, len);
1677 Tcl_DStringAppend(dsPtr, "NewCenturySchlbk", -1);
1678 family = Tcl_DStringValue(dsPtr) + len;
1679 }
1680
1681 /*
1682 * Get the string to use for the weight.
1683 */
1684
1685 weightString = NULL;
1686 if (fontPtr->fa.weight == TK_FW_NORMAL) {
1687 if (strcmp(family, "Bookman") == 0) {
1688 weightString = "Light";
1689 } else if (strcmp(family, "AvantGarde") == 0) {
1690 weightString = "Book";
1691 } else if (strcmp(family, "ZapfChancery") == 0) {
1692 weightString = "Medium";
1693 }
1694 } else {
1695 if ((strcmp(family, "Bookman") == 0)
1696 || (strcmp(family, "AvantGarde") == 0)) {
1697 weightString = "Demi";
1698 } else {
1699 weightString = "Bold";
1700 }
1701 }
1702
1703 /*
1704 * Get the string to use for the slant.
1705 */
1706
1707 slantString = NULL;
1708 if (fontPtr->fa.slant == TK_FS_ROMAN) {
1709 ;
1710 } else {
1711 if ((strcmp(family, "Helvetica") == 0)
1712 || (strcmp(family, "Courier") == 0)
1713 || (strcmp(family, "AvantGarde") == 0)) {
1714 slantString = "Oblique";
1715 } else {
1716 slantString = "Italic";
1717 }
1718 }
1719
1720 /*
1721 * The string "Roman" needs to be added to some fonts that are not bold
1722 * and not italic.
1723 */
1724
1725 if ((slantString == NULL) && (weightString == NULL)) {
1726 if ((strcmp(family, "Times") == 0)
1727 || (strcmp(family, "NewCenturySchlbk") == 0)
1728 || (strcmp(family, "Palatino") == 0)) {
1729 Tcl_DStringAppend(dsPtr, "-Roman", -1);
1730 }
1731 } else {
1732 Tcl_DStringAppend(dsPtr, "-", -1);
1733 if (weightString != NULL) {
1734 Tcl_DStringAppend(dsPtr, weightString, -1);
1735 }
1736 if (slantString != NULL) {
1737 Tcl_DStringAppend(dsPtr, slantString, -1);
1738 }
1739 }
1740
1741 return TkFontGetPoints(fontPtr->screen, fontPtr->fa.size);
1742 }
1743
1744 /*
1745 *---------------------------------------------------------------------------
1746 *
1747 * Tk_TextWidth --
1748 *
1749 * A wrapper function for the more complicated interface of
1750 * Tk_MeasureChars. Computes how much space the given
1751 * simple string needs.
1752 *
1753 * Results:
1754 * The return value is the width (in pixels) of the given string.
1755 *
1756 * Side effects:
1757 * None.
1758 *
1759 *---------------------------------------------------------------------------
1760 */
1761
1762 int
Tk_TextWidth(tkfont,string,numBytes)1763 Tk_TextWidth(tkfont, string, numBytes)
1764 Tk_Font tkfont; /* Font in which text will be measured. */
1765 CONST char *string; /* String whose width will be computed. */
1766 int numBytes; /* Number of bytes to consider from
1767 * string, or < 0 for strlen(). */
1768 {
1769 int width;
1770
1771 if (numBytes < 0) {
1772 numBytes = strlen(string);
1773 }
1774 Tk_MeasureChars(tkfont, string, numBytes, -1, 0, &width);
1775 return width;
1776 }
1777
1778 /*
1779 *---------------------------------------------------------------------------
1780 *
1781 * Tk_UnderlineChars --
1782 *
1783 * This procedure draws an underline for a given range of characters
1784 * in a given string. It doesn't draw the characters (which are
1785 * assumed to have been displayed previously); it just draws the
1786 * underline. This procedure would mainly be used to quickly
1787 * underline a few characters without having to construct an
1788 * underlined font. To produce properly underlined text, the
1789 * appropriate underlined font should be constructed and used.
1790 *
1791 * Results:
1792 * None.
1793 *
1794 * Side effects:
1795 * Information gets displayed in "drawable".
1796 *
1797 *----------------------------------------------------------------------
1798 */
1799
1800 void
Tk_UnderlineChars(display,drawable,gc,tkfont,string,x,y,firstByte,lastByte)1801 Tk_UnderlineChars(display, drawable, gc, tkfont, string, x, y, firstByte,
1802 lastByte)
1803 Display *display; /* Display on which to draw. */
1804 Drawable drawable; /* Window or pixmap in which to draw. */
1805 GC gc; /* Graphics context for actually drawing
1806 * line. */
1807 Tk_Font tkfont; /* Font used in GC; must have been allocated
1808 * by Tk_GetFont(). Used for character
1809 * dimensions, etc. */
1810 CONST char *string; /* String containing characters to be
1811 * underlined or overstruck. */
1812 int x, y; /* Coordinates at which first character of
1813 * string is drawn. */
1814 int firstByte; /* Index of first byte of first character. */
1815 int lastByte; /* Index of first byte after the last
1816 * character. */
1817 {
1818 TkFont *fontPtr;
1819 int startX, endX;
1820
1821 fontPtr = (TkFont *) tkfont;
1822
1823 Tk_MeasureChars(tkfont, string, firstByte, -1, 0, &startX);
1824 Tk_MeasureChars(tkfont, string, lastByte, -1, 0, &endX);
1825
1826 XFillRectangle(display, drawable, gc, x + startX,
1827 y + fontPtr->underlinePos, (unsigned int) (endX - startX),
1828 (unsigned int) fontPtr->underlineHeight);
1829 }
1830
1831 /*
1832 *---------------------------------------------------------------------------
1833 *
1834 * Tk_ComputeTextLayout --
1835 *
1836 * Computes the amount of screen space needed to display a
1837 * multi-line, justified string of text. Records all the
1838 * measurements that were done to determine to size and
1839 * positioning of the individual lines of text; this information
1840 * can be used by the Tk_DrawTextLayout() procedure to
1841 * display the text quickly (without remeasuring it).
1842 *
1843 * This procedure is useful for simple widgets that want to
1844 * display single-font, multi-line text and want Tk to handle the
1845 * details.
1846 *
1847 * Results:
1848 * The return value is a Tk_TextLayout token that holds the
1849 * measurement information for the given string. The token is
1850 * only valid for the given string. If the string is freed,
1851 * the token is no longer valid and must also be freed. To free
1852 * the token, call Tk_FreeTextLayout().
1853 *
1854 * The dimensions of the screen area needed to display the text
1855 * are stored in *widthPtr and *heightPtr.
1856 *
1857 * Side effects:
1858 * Memory is allocated to hold the measurement information.
1859 *
1860 *---------------------------------------------------------------------------
1861 */
1862
1863 Tk_TextLayout
Tk_ComputeTextLayout(tkfont,string,numChars,wrapLength,justify,flags,widthPtr,heightPtr)1864 Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
1865 widthPtr, heightPtr)
1866 Tk_Font tkfont; /* Font that will be used to display text. */
1867 CONST char *string; /* String whose dimensions are to be
1868 * computed. */
1869 int numChars; /* Number of characters to consider from
1870 * string, or < 0 for strlen(). */
1871 int wrapLength; /* Longest permissible line length, in
1872 * pixels. <= 0 means no automatic wrapping:
1873 * just let lines get as long as needed. */
1874 Tk_Justify justify; /* How to justify lines. */
1875 int flags; /* Flag bits OR-ed together.
1876 * TK_IGNORE_TABS means that tab characters
1877 * should not be expanded. TK_IGNORE_NEWLINES
1878 * means that newline characters should not
1879 * cause a line break. */
1880 int *widthPtr; /* Filled with width of string. */
1881 int *heightPtr; /* Filled with height of string. */
1882 {
1883 TkFont *fontPtr;
1884 CONST char *start, *end, *special;
1885 int n, y, bytesThisChunk, maxChunks;
1886 int baseline, height, curX, newX, maxWidth;
1887 TextLayout *layoutPtr;
1888 LayoutChunk *chunkPtr;
1889 CONST TkFontMetrics *fmPtr;
1890 Tcl_DString lineBuffer;
1891 int *lineLengths;
1892 int curLine, layoutHeight;
1893
1894 Tcl_DStringInit(&lineBuffer);
1895
1896 fontPtr = (TkFont *) tkfont;
1897 if ((fontPtr == NULL) || (string == NULL)) {
1898 if (widthPtr != NULL) {
1899 *widthPtr = 0;
1900 }
1901 if (heightPtr != NULL) {
1902 *heightPtr = 0;
1903 }
1904 return NULL;
1905 }
1906
1907 fmPtr = &fontPtr->fm;
1908
1909 height = fmPtr->ascent + fmPtr->descent;
1910
1911 if (numChars < 0) {
1912 numChars = Tcl_NumUtfChars(string, -1);
1913 }
1914 if (wrapLength == 0) {
1915 wrapLength = -1;
1916 }
1917
1918 maxChunks = 1;
1919
1920 layoutPtr = (TextLayout *) ckalloc(sizeof(TextLayout)
1921 + (maxChunks - 1) * sizeof(LayoutChunk));
1922 layoutPtr->tkfont = tkfont;
1923 layoutPtr->string = string;
1924 layoutPtr->numChunks = 0;
1925
1926 baseline = fmPtr->ascent;
1927 maxWidth = 0;
1928
1929 /*
1930 * Divide the string up into simple strings and measure each string.
1931 */
1932
1933 curX = 0;
1934
1935 end = Tcl_UtfAtIndex(string, numChars);
1936 special = string;
1937
1938 flags &= TK_IGNORE_TABS | TK_IGNORE_NEWLINES;
1939 flags |= TK_WHOLE_WORDS | TK_AT_LEAST_ONE;
1940 for (start = string; start < end; ) {
1941 if (start >= special) {
1942 /*
1943 * Find the next special character in the string.
1944 *
1945 * INTL: Note that it is safe to increment by byte, because we are
1946 * looking for 7-bit characters that will appear unchanged in
1947 * UTF-8. At some point we may need to support the full Unicode
1948 * whitespace set.
1949 */
1950
1951 for (special = start; special < end; special++) {
1952 if (!(flags & TK_IGNORE_NEWLINES)) {
1953 if ((*special == '\n') || (*special == '\r')) {
1954 break;
1955 }
1956 }
1957 if (!(flags & TK_IGNORE_TABS)) {
1958 if (*special == '\t') {
1959 break;
1960 }
1961 }
1962 }
1963 }
1964
1965 /*
1966 * Special points at the next special character (or the end of the
1967 * string). Process characters between start and special.
1968 */
1969
1970 chunkPtr = NULL;
1971 if (start < special) {
1972 bytesThisChunk = Tk_MeasureChars(tkfont, start, special - start,
1973 wrapLength - curX, flags, &newX);
1974 newX += curX;
1975 flags &= ~TK_AT_LEAST_ONE;
1976 if (bytesThisChunk > 0) {
1977 chunkPtr = NewChunk(&layoutPtr, &maxChunks, start,
1978 bytesThisChunk, curX, newX, baseline);
1979
1980 start += bytesThisChunk;
1981 curX = newX;
1982 }
1983 }
1984
1985 if ((start == special) && (special < end)) {
1986 /*
1987 * Handle the special character.
1988 *
1989 * INTL: Special will be pointing at a 7-bit character so we
1990 * can safely treat it as a single byte.
1991 */
1992
1993 chunkPtr = NULL;
1994 if (*special == '\t') {
1995 newX = curX + fontPtr->tabWidth;
1996 newX -= newX % fontPtr->tabWidth;
1997 NewChunk(&layoutPtr, &maxChunks, start, 1, curX, newX,
1998 baseline)->numDisplayChars = -1;
1999 start++;
2000 if ((start < end) &&
2001 ((wrapLength <= 0) || (newX <= wrapLength))) {
2002 /*
2003 * More chars can still fit on this line.
2004 */
2005
2006 curX = newX;
2007 flags &= ~TK_AT_LEAST_ONE;
2008 continue;
2009 }
2010 } else {
2011 NewChunk(&layoutPtr, &maxChunks, start, 1, curX, curX,
2012 baseline)->numDisplayChars = -1;
2013 start++;
2014 goto wrapLine;
2015 }
2016 }
2017
2018 /*
2019 * No more characters are going to go on this line, either because
2020 * no more characters can fit or there are no more characters left.
2021 * Consume all extra spaces at end of line.
2022 */
2023
2024 while ((start < end) && isspace(UCHAR(*start))) { /* INTL: ISO space */
2025 if (!(flags & TK_IGNORE_NEWLINES)) {
2026 if ((*start == '\n') || (*start == '\r')) {
2027 break;
2028 }
2029 }
2030 if (!(flags & TK_IGNORE_TABS)) {
2031 if (*start == '\t') {
2032 break;
2033 }
2034 }
2035 start++;
2036 }
2037 if (chunkPtr != NULL) {
2038 CONST char *end;
2039
2040 /*
2041 * Append all the extra spaces on this line to the end of the
2042 * last text chunk. This is a little tricky because we are
2043 * switching back and forth between characters and bytes.
2044 */
2045
2046 end = chunkPtr->start + chunkPtr->numBytes;
2047 bytesThisChunk = start - end;
2048 if (bytesThisChunk > 0) {
2049 bytesThisChunk = Tk_MeasureChars(tkfont, end, bytesThisChunk,
2050 -1, 0, &chunkPtr->totalWidth);
2051 chunkPtr->numBytes += bytesThisChunk;
2052 chunkPtr->numChars += Tcl_NumUtfChars(end, bytesThisChunk);
2053 chunkPtr->totalWidth += curX;
2054 }
2055 }
2056
2057 wrapLine:
2058 flags |= TK_AT_LEAST_ONE;
2059
2060 /*
2061 * Save current line length, then move current position to start of
2062 * next line.
2063 */
2064
2065 if (curX > maxWidth) {
2066 maxWidth = curX;
2067 }
2068
2069 /*
2070 * Remember width of this line, so that all chunks on this line
2071 * can be centered or right justified, if necessary.
2072 */
2073
2074 Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
2075
2076 curX = 0;
2077 baseline += height;
2078 }
2079
2080 /*
2081 * If last line ends with a newline, then we need to make a 0 width
2082 * chunk on the next line. Otherwise "Hello" and "Hello\n" are the
2083 * same height.
2084 */
2085
2086 if ((layoutPtr->numChunks > 0) && ((flags & TK_IGNORE_NEWLINES) == 0)) {
2087 if (layoutPtr->chunks[layoutPtr->numChunks - 1].start[0] == '\n') {
2088 chunkPtr = NewChunk(&layoutPtr, &maxChunks, start, 0, curX,
2089 curX, baseline);
2090 chunkPtr->numDisplayChars = -1;
2091 Tcl_DStringAppend(&lineBuffer, (char *) &curX, sizeof(curX));
2092 baseline += height;
2093 }
2094 }
2095
2096 layoutPtr->width = maxWidth;
2097 layoutHeight = baseline - fmPtr->ascent;
2098 if (layoutPtr->numChunks == 0) {
2099 layoutHeight = height;
2100
2101 /*
2102 * This fake chunk is used by the other procedures so that they can
2103 * pretend that there is a chunk with no chars in it, which makes
2104 * the coding simpler.
2105 */
2106
2107 layoutPtr->numChunks = 1;
2108 layoutPtr->chunks[0].start = string;
2109 layoutPtr->chunks[0].numBytes = 0;
2110 layoutPtr->chunks[0].numChars = 0;
2111 layoutPtr->chunks[0].numDisplayChars = -1;
2112 layoutPtr->chunks[0].x = 0;
2113 layoutPtr->chunks[0].y = fmPtr->ascent;
2114 layoutPtr->chunks[0].totalWidth = 0;
2115 layoutPtr->chunks[0].displayWidth = 0;
2116 } else {
2117 /*
2118 * Using maximum line length, shift all the chunks so that the lines
2119 * are all justified correctly.
2120 */
2121
2122 curLine = 0;
2123 chunkPtr = layoutPtr->chunks;
2124 y = chunkPtr->y;
2125 lineLengths = (int *) Tcl_DStringValue(&lineBuffer);
2126 for (n = 0; n < layoutPtr->numChunks; n++) {
2127 int extra;
2128
2129 if (chunkPtr->y != y) {
2130 curLine++;
2131 y = chunkPtr->y;
2132 }
2133 extra = maxWidth - lineLengths[curLine];
2134 if (justify == TK_JUSTIFY_CENTER) {
2135 chunkPtr->x += extra / 2;
2136 } else if (justify == TK_JUSTIFY_RIGHT) {
2137 chunkPtr->x += extra;
2138 }
2139 chunkPtr++;
2140 }
2141 }
2142
2143 if (widthPtr != NULL) {
2144 *widthPtr = layoutPtr->width;
2145 }
2146 if (heightPtr != NULL) {
2147 *heightPtr = layoutHeight;
2148 }
2149 Tcl_DStringFree(&lineBuffer);
2150
2151 return (Tk_TextLayout) layoutPtr;
2152 }
2153
2154 /*
2155 *---------------------------------------------------------------------------
2156 *
2157 * Tk_FreeTextLayout --
2158 *
2159 * This procedure is called to release the storage associated with
2160 * a Tk_TextLayout when it is no longer needed.
2161 *
2162 * Results:
2163 * None.
2164 *
2165 * Side effects:
2166 * Memory is freed.
2167 *
2168 *---------------------------------------------------------------------------
2169 */
2170
2171 void
Tk_FreeTextLayout(textLayout)2172 Tk_FreeTextLayout(textLayout)
2173 Tk_TextLayout textLayout; /* The text layout to be released. */
2174 {
2175 TextLayout *layoutPtr;
2176
2177 layoutPtr = (TextLayout *) textLayout;
2178 if (layoutPtr != NULL) {
2179 ckfree((char *) layoutPtr);
2180 }
2181 }
2182
2183 /*
2184 *---------------------------------------------------------------------------
2185 *
2186 * Tk_DrawTextLayout --
2187 *
2188 * Use the information in the Tk_TextLayout token to display a
2189 * multi-line, justified string of text.
2190 *
2191 * This procedure is useful for simple widgets that need to
2192 * display single-font, multi-line text and want Tk to handle
2193 * the details.
2194 *
2195 * Results:
2196 * None.
2197 *
2198 * Side effects:
2199 * Text drawn on the screen.
2200 *
2201 *---------------------------------------------------------------------------
2202 */
2203
2204 void
Tk_DrawTextLayout(display,drawable,gc,layout,x,y,firstChar,lastChar)2205 Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar)
2206 Display *display; /* Display on which to draw. */
2207 Drawable drawable; /* Window or pixmap in which to draw. */
2208 GC gc; /* Graphics context to use for drawing text. */
2209 Tk_TextLayout layout; /* Layout information, from a previous call
2210 * to Tk_ComputeTextLayout(). */
2211 int x, y; /* Upper-left hand corner of rectangle in
2212 * which to draw (pixels). */
2213 int firstChar; /* The index of the first character to draw
2214 * from the given text item. 0 specfies the
2215 * beginning. */
2216 int lastChar; /* The index just after the last character
2217 * to draw from the given text item. A number
2218 * < 0 means to draw all characters. */
2219 {
2220 TextLayout *layoutPtr;
2221 int i, numDisplayChars, drawX;
2222 CONST char *firstByte;
2223 CONST char *lastByte;
2224 LayoutChunk *chunkPtr;
2225
2226 layoutPtr = (TextLayout *) layout;
2227 if (layoutPtr == NULL) {
2228 return;
2229 }
2230
2231 if (lastChar < 0) {
2232 lastChar = 100000000;
2233 }
2234 chunkPtr = layoutPtr->chunks;
2235 for (i = 0; i < layoutPtr->numChunks; i++) {
2236 numDisplayChars = chunkPtr->numDisplayChars;
2237 if ((numDisplayChars > 0) && (firstChar < numDisplayChars)) {
2238 if (firstChar <= 0) {
2239 drawX = 0;
2240 firstChar = 0;
2241 firstByte = chunkPtr->start;
2242 } else {
2243 firstByte = Tcl_UtfAtIndex(chunkPtr->start, firstChar);
2244 Tk_MeasureChars(layoutPtr->tkfont, chunkPtr->start,
2245 firstByte - chunkPtr->start, -1, 0, &drawX);
2246 }
2247 if (lastChar < numDisplayChars) {
2248 numDisplayChars = lastChar;
2249 }
2250 lastByte = Tcl_UtfAtIndex(chunkPtr->start, numDisplayChars);
2251 Tk_DrawChars(display, drawable, gc, layoutPtr->tkfont,
2252 firstByte, lastByte - firstByte,
2253 x + chunkPtr->x + drawX, y + chunkPtr->y);
2254 }
2255 firstChar -= chunkPtr->numChars;
2256 lastChar -= chunkPtr->numChars;
2257 if (lastChar <= 0) {
2258 break;
2259 }
2260 chunkPtr++;
2261 }
2262 }
2263
2264 /*
2265 *---------------------------------------------------------------------------
2266 *
2267 * Tk_UnderlineTextLayout --
2268 *
2269 * Use the information in the Tk_TextLayout token to display an
2270 * underline below an individual character. This procedure does
2271 * not draw the text, just the underline.
2272 *
2273 * This procedure is useful for simple widgets that need to
2274 * display single-font, multi-line text with an individual
2275 * character underlined and want Tk to handle the details.
2276 * To display larger amounts of underlined text, construct
2277 * and use an underlined font.
2278 *
2279 * Results:
2280 * None.
2281 *
2282 * Side effects:
2283 * Underline drawn on the screen.
2284 *
2285 *---------------------------------------------------------------------------
2286 */
2287
2288 void
Tk_UnderlineTextLayout(display,drawable,gc,layout,x,y,underline)2289 Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline)
2290 Display *display; /* Display on which to draw. */
2291 Drawable drawable; /* Window or pixmap in which to draw. */
2292 GC gc; /* Graphics context to use for drawing text. */
2293 Tk_TextLayout layout; /* Layout information, from a previous call
2294 * to Tk_ComputeTextLayout(). */
2295 int x, y; /* Upper-left hand corner of rectangle in
2296 * which to draw (pixels). */
2297 int underline; /* Index of the single character to
2298 * underline, or -1 for no underline. */
2299 {
2300 TextLayout *layoutPtr;
2301 TkFont *fontPtr;
2302 int xx, yy, width, height;
2303
2304 if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
2305 && (width != 0)) {
2306 layoutPtr = (TextLayout *) layout;
2307 fontPtr = (TkFont *) layoutPtr->tkfont;
2308
2309 XFillRectangle(display, drawable, gc, x + xx,
2310 y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
2311 (unsigned int) width, (unsigned int) fontPtr->underlineHeight);
2312 }
2313 }
2314
2315 /*
2316 *---------------------------------------------------------------------------
2317 *
2318 * Tk_PointToChar --
2319 *
2320 * Use the information in the Tk_TextLayout token to determine the
2321 * character closest to the given point. The point must be
2322 * specified with respect to the upper-left hand corner of the
2323 * text layout, which is considered to be located at (0, 0).
2324 *
2325 * Any point whose y-value is less that 0 will be considered closest
2326 * to the first character in the text layout; any point whose y-value
2327 * is greater than the height of the text layout will be considered
2328 * closest to the last character in the text layout.
2329 *
2330 * Any point whose x-value is less than 0 will be considered closest
2331 * to the first character on that line; any point whose x-value is
2332 * greater than the width of the text layout will be considered
2333 * closest to the last character on that line.
2334 *
2335 * Results:
2336 * The return value is the index of the character that was
2337 * closest to the point. Given a text layout with no characters,
2338 * the value 0 will always be returned, referring to a hypothetical
2339 * zero-width placeholder character.
2340 *
2341 * Side effects:
2342 * None.
2343 *
2344 *---------------------------------------------------------------------------
2345 */
2346
2347 int
Tk_PointToChar(layout,x,y)2348 Tk_PointToChar(layout, x, y)
2349 Tk_TextLayout layout; /* Layout information, from a previous call
2350 * to Tk_ComputeTextLayout(). */
2351 int x, y; /* Coordinates of point to check, with
2352 * respect to the upper-left corner of the
2353 * text layout. */
2354 {
2355 TextLayout *layoutPtr;
2356 LayoutChunk *chunkPtr, *lastPtr;
2357 TkFont *fontPtr;
2358 int i, n, dummy, baseline, pos, numChars;
2359
2360 if (y < 0) {
2361 /*
2362 * Point lies above any line in this layout. Return the index of
2363 * the first char.
2364 */
2365
2366 return 0;
2367 }
2368
2369 /*
2370 * Find which line contains the point.
2371 */
2372
2373 layoutPtr = (TextLayout *) layout;
2374 fontPtr = (TkFont *) layoutPtr->tkfont;
2375 lastPtr = chunkPtr = layoutPtr->chunks;
2376 numChars = 0;
2377 for (i = 0; i < layoutPtr->numChunks; i++) {
2378 baseline = chunkPtr->y;
2379 if (y < baseline + fontPtr->fm.descent) {
2380 if (x < chunkPtr->x) {
2381 /*
2382 * Point is to the left of all chunks on this line. Return
2383 * the index of the first character on this line.
2384 */
2385
2386 return numChars;
2387 }
2388 if (x >= layoutPtr->width) {
2389 /*
2390 * If point lies off right side of the text layout, return
2391 * the last char in the last chunk on this line. Without
2392 * this, it might return the index of the first char that
2393 * was located outside of the text layout.
2394 */
2395
2396 x = INT_MAX;
2397 }
2398
2399 /*
2400 * Examine all chunks on this line to see which one contains
2401 * the specified point.
2402 */
2403
2404 lastPtr = chunkPtr;
2405 while ((i < layoutPtr->numChunks) && (chunkPtr->y == baseline)) {
2406 if (x < chunkPtr->x + chunkPtr->totalWidth) {
2407 /*
2408 * Point falls on one of the characters in this chunk.
2409 */
2410
2411 if (chunkPtr->numDisplayChars < 0) {
2412 /*
2413 * This is a special chunk that encapsulates a single
2414 * tab or newline char.
2415 */
2416
2417 return numChars;
2418 }
2419 n = Tk_MeasureChars((Tk_Font) fontPtr, chunkPtr->start,
2420 chunkPtr->numBytes, x - chunkPtr->x,
2421 0, &dummy);
2422 return numChars + Tcl_NumUtfChars(chunkPtr->start, n);
2423 }
2424 numChars += chunkPtr->numChars;
2425 lastPtr = chunkPtr;
2426 chunkPtr++;
2427 i++;
2428 }
2429
2430 /*
2431 * Point is to the right of all chars in all the chunks on this
2432 * line. Return the index just past the last char in the last
2433 * chunk on this line.
2434 */
2435
2436 pos = numChars;
2437 if (i < layoutPtr->numChunks) {
2438 pos--;
2439 }
2440 return pos;
2441 }
2442 numChars += chunkPtr->numChars;
2443 lastPtr = chunkPtr;
2444 chunkPtr++;
2445 }
2446
2447 /*
2448 * Point lies below any line in this text layout. Return the index
2449 * just past the last char.
2450 */
2451
2452 return (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
2453 }
2454
2455 /*
2456 *---------------------------------------------------------------------------
2457 *
2458 * Tk_CharBbox --
2459 *
2460 * Use the information in the Tk_TextLayout token to return the
2461 * bounding box for the character specified by index.
2462 *
2463 * The width of the bounding box is the advance width of the
2464 * character, and does not include and left- or right-bearing.
2465 * Any character that extends partially outside of the
2466 * text layout is considered to be truncated at the edge. Any
2467 * character which is located completely outside of the text
2468 * layout is considered to be zero-width and pegged against
2469 * the edge.
2470 *
2471 * The height of the bounding box is the line height for this font,
2472 * extending from the top of the ascent to the bottom of the
2473 * descent. Information about the actual height of the individual
2474 * letter is not available.
2475 *
2476 * A text layout that contains no characters is considered to
2477 * contain a single zero-width placeholder character.
2478 *
2479 * Results:
2480 * The return value is 0 if the index did not specify a character
2481 * in the text layout, or non-zero otherwise. In that case,
2482 * *bbox is filled with the bounding box of the character.
2483 *
2484 * Side effects:
2485 * None.
2486 *
2487 *---------------------------------------------------------------------------
2488 */
2489
2490 int
Tk_CharBbox(layout,index,xPtr,yPtr,widthPtr,heightPtr)2491 Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr)
2492 Tk_TextLayout layout; /* Layout information, from a previous call to
2493 * Tk_ComputeTextLayout(). */
2494 int index; /* The index of the character whose bbox is
2495 * desired. */
2496 int *xPtr, *yPtr; /* Filled with the upper-left hand corner, in
2497 * pixels, of the bounding box for the character
2498 * specified by index, if non-NULL. */
2499 int *widthPtr, *heightPtr;
2500 /* Filled with the width and height of the
2501 * bounding box for the character specified by
2502 * index, if non-NULL. */
2503 {
2504 TextLayout *layoutPtr;
2505 LayoutChunk *chunkPtr;
2506 int i, x, w;
2507 Tk_Font tkfont;
2508 TkFont *fontPtr;
2509 CONST char *end;
2510
2511 if (index < 0) {
2512 return 0;
2513 }
2514
2515 layoutPtr = (TextLayout *) layout;
2516 chunkPtr = layoutPtr->chunks;
2517 tkfont = layoutPtr->tkfont;
2518 fontPtr = (TkFont *) tkfont;
2519
2520 for (i = 0; i < layoutPtr->numChunks; i++) {
2521 if (chunkPtr->numDisplayChars < 0) {
2522 if (index == 0) {
2523 x = chunkPtr->x;
2524 w = chunkPtr->totalWidth;
2525 goto check;
2526 }
2527 } else if (index < chunkPtr->numChars) {
2528 end = Tcl_UtfAtIndex(chunkPtr->start, index);
2529 if (xPtr != NULL) {
2530 Tk_MeasureChars(tkfont, chunkPtr->start,
2531 end - chunkPtr->start, -1, 0, &x);
2532 x += chunkPtr->x;
2533 }
2534 if (widthPtr != NULL) {
2535 Tk_MeasureChars(tkfont, end, Tcl_UtfNext(end) - end,
2536 -1, 0, &w);
2537 }
2538 goto check;
2539 }
2540 index -= chunkPtr->numChars;
2541 chunkPtr++;
2542 }
2543 if (index == 0) {
2544 /*
2545 * Special case to get location just past last char in layout.
2546 */
2547
2548 chunkPtr--;
2549 x = chunkPtr->x + chunkPtr->totalWidth;
2550 w = 0;
2551 } else {
2552 return 0;
2553 }
2554
2555 /*
2556 * Ensure that the bbox lies within the text layout. This forces all
2557 * chars that extend off the right edge of the text layout to have
2558 * truncated widths, and all chars that are completely off the right
2559 * edge of the text layout to peg to the edge and have 0 width.
2560 */
2561 check:
2562 if (yPtr != NULL) {
2563 *yPtr = chunkPtr->y - fontPtr->fm.ascent;
2564 }
2565 if (heightPtr != NULL) {
2566 *heightPtr = fontPtr->fm.ascent + fontPtr->fm.descent;
2567 }
2568
2569 if (x > layoutPtr->width) {
2570 x = layoutPtr->width;
2571 }
2572 if (xPtr != NULL) {
2573 *xPtr = x;
2574 }
2575 if (widthPtr != NULL) {
2576 if (x + w > layoutPtr->width) {
2577 w = layoutPtr->width - x;
2578 }
2579 *widthPtr = w;
2580 }
2581
2582 return 1;
2583 }
2584
2585 /*
2586 *---------------------------------------------------------------------------
2587 *
2588 * Tk_DistanceToTextLayout --
2589 *
2590 * Computes the distance in pixels from the given point to the
2591 * given text layout. Non-displaying space characters that occur
2592 * at the end of individual lines in the text layout are ignored
2593 * for hit detection purposes.
2594 *
2595 * Results:
2596 * The return value is 0 if the point (x, y) is inside the text
2597 * layout. If the point isn't inside the text layout then the
2598 * return value is the distance in pixels from the point to the
2599 * text item.
2600 *
2601 * Side effects:
2602 * None.
2603 *
2604 *---------------------------------------------------------------------------
2605 */
2606
2607 int
Tk_DistanceToTextLayout(layout,x,y)2608 Tk_DistanceToTextLayout(layout, x, y)
2609 Tk_TextLayout layout; /* Layout information, from a previous call
2610 * to Tk_ComputeTextLayout(). */
2611 int x, y; /* Coordinates of point to check, with
2612 * respect to the upper-left corner of the
2613 * text layout (in pixels). */
2614 {
2615 int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
2616 LayoutChunk *chunkPtr;
2617 TextLayout *layoutPtr;
2618 TkFont *fontPtr;
2619
2620 layoutPtr = (TextLayout *) layout;
2621 fontPtr = (TkFont *) layoutPtr->tkfont;
2622 ascent = fontPtr->fm.ascent;
2623 descent = fontPtr->fm.descent;
2624
2625 minDist = 0;
2626 chunkPtr = layoutPtr->chunks;
2627 for (i = 0; i < layoutPtr->numChunks; i++) {
2628 if (chunkPtr->start[0] == '\n') {
2629 /*
2630 * Newline characters are not counted when computing distance
2631 * (but tab characters would still be considered).
2632 */
2633
2634 chunkPtr++;
2635 continue;
2636 }
2637
2638 x1 = chunkPtr->x;
2639 y1 = chunkPtr->y - ascent;
2640 x2 = chunkPtr->x + chunkPtr->displayWidth;
2641 y2 = chunkPtr->y + descent;
2642
2643 if (x < x1) {
2644 xDiff = x1 - x;
2645 } else if (x >= x2) {
2646 xDiff = x - x2 + 1;
2647 } else {
2648 xDiff = 0;
2649 }
2650
2651 if (y < y1) {
2652 yDiff = y1 - y;
2653 } else if (y >= y2) {
2654 yDiff = y - y2 + 1;
2655 } else {
2656 yDiff = 0;
2657 }
2658 if ((xDiff == 0) && (yDiff == 0)) {
2659 return 0;
2660 }
2661 dist = (int) hypot((double) xDiff, (double) yDiff);
2662 if ((dist < minDist) || (minDist == 0)) {
2663 minDist = dist;
2664 }
2665 chunkPtr++;
2666 }
2667 return minDist;
2668 }
2669
2670 /*
2671 *---------------------------------------------------------------------------
2672 *
2673 * Tk_IntersectTextLayout --
2674 *
2675 * Determines whether a text layout lies entirely inside,
2676 * entirely outside, or overlaps a given rectangle. Non-displaying
2677 * space characters that occur at the end of individual lines in
2678 * the text layout are ignored for intersection calculations.
2679 *
2680 * Results:
2681 * The return value is -1 if the text layout is entirely outside of
2682 * the rectangle, 0 if it overlaps, and 1 if it is entirely inside
2683 * of the rectangle.
2684 *
2685 * Side effects:
2686 * None.
2687 *
2688 *---------------------------------------------------------------------------
2689 */
2690
2691 int
Tk_IntersectTextLayout(layout,x,y,width,height)2692 Tk_IntersectTextLayout(layout, x, y, width, height)
2693 Tk_TextLayout layout; /* Layout information, from a previous call
2694 * to Tk_ComputeTextLayout(). */
2695 int x, y; /* Upper-left hand corner, in pixels, of
2696 * rectangular area to compare with text
2697 * layout. Coordinates are with respect to
2698 * the upper-left hand corner of the text
2699 * layout itself. */
2700 int width, height; /* The width and height of the above
2701 * rectangular area, in pixels. */
2702 {
2703 int result, i, x1, y1, x2, y2;
2704 TextLayout *layoutPtr;
2705 LayoutChunk *chunkPtr;
2706 TkFont *fontPtr;
2707 int left, top, right, bottom;
2708
2709 /*
2710 * Scan the chunks one at a time, seeing whether each is entirely in,
2711 * entirely out, or overlapping the rectangle. If an overlap is
2712 * detected, return immediately; otherwise wait until all chunks have
2713 * been processed and see if they were all inside or all outside.
2714 */
2715
2716 layoutPtr = (TextLayout *) layout;
2717 chunkPtr = layoutPtr->chunks;
2718 fontPtr = (TkFont *) layoutPtr->tkfont;
2719
2720 left = x;
2721 top = y;
2722 right = x + width;
2723 bottom = y + height;
2724
2725 result = 0;
2726 for (i = 0; i < layoutPtr->numChunks; i++) {
2727 if (chunkPtr->start[0] == '\n') {
2728 /*
2729 * Newline characters are not counted when computing area
2730 * intersection (but tab characters would still be considered).
2731 */
2732
2733 chunkPtr++;
2734 continue;
2735 }
2736
2737 x1 = chunkPtr->x;
2738 y1 = chunkPtr->y - fontPtr->fm.ascent;
2739 x2 = chunkPtr->x + chunkPtr->displayWidth;
2740 y2 = chunkPtr->y + fontPtr->fm.descent;
2741
2742 if ((right < x1) || (left >= x2)
2743 || (bottom < y1) || (top >= y2)) {
2744 if (result == 1) {
2745 return 0;
2746 }
2747 result = -1;
2748 } else if ((x1 < left) || (x2 >= right)
2749 || (y1 < top) || (y2 >= bottom)) {
2750 return 0;
2751 } else if (result == -1) {
2752 return 0;
2753 } else {
2754 result = 1;
2755 }
2756 chunkPtr++;
2757 }
2758 return result;
2759 }
2760
2761 /*
2762 *---------------------------------------------------------------------------
2763 *
2764 * Tk_TextLayoutToPostscript --
2765 *
2766 * Outputs the contents of a text layout in Postscript format.
2767 * The set of lines in the text layout will be rendered by the user
2768 * supplied Postscript function. The function should be of the form:
2769 *
2770 * justify x y string function --
2771 *
2772 * Justify is -1, 0, or 1, depending on whether the following string
2773 * should be left, center, or right justified, x and y is the
2774 * location for the origin of the string, string is the sequence
2775 * of characters to be printed, and function is the name of the
2776 * caller-provided function; the function should leave nothing
2777 * on the stack.
2778 *
2779 * The meaning of the origin of the string (x and y) depends on
2780 * the justification. For left justification, x is where the
2781 * left edge of the string should appear. For center justification,
2782 * x is where the center of the string should appear. And for right
2783 * justification, x is where the right edge of the string should
2784 * appear. This behavior is necessary because, for example, right
2785 * justified text on the screen is justified with screen metrics.
2786 * The same string needs to be justified with printer metrics on
2787 * the printer to appear in the correct place with respect to other
2788 * similarly justified strings. In all circumstances, y is the
2789 * location of the baseline for the string.
2790 *
2791 * Results:
2792 * The interp's result is modified to hold the Postscript code that
2793 * will render the text layout.
2794 *
2795 * Side effects:
2796 * None.
2797 *
2798 *---------------------------------------------------------------------------
2799 */
2800
2801 void
Tk_TextLayoutToPostscript(interp,layout)2802 Tk_TextLayoutToPostscript(interp, layout)
2803 Tcl_Interp *interp; /* Filled with Postscript code. */
2804 Tk_TextLayout layout; /* The layout to be rendered. */
2805 {
2806 #define MAXUSE 128
2807 char buf[MAXUSE+30];
2808 LayoutChunk *chunkPtr;
2809 int i, j, used, c, baseline;
2810 Tcl_UniChar ch;
2811 CONST char *p, *last_p,*glyphname;
2812 TextLayout *layoutPtr;
2813 char uindex[5]="\0\0\0\0";
2814 char one_char[5];
2815 int charsize;
2816 int bytecount=0;
2817
2818 layoutPtr = (TextLayout *) layout;
2819 chunkPtr = layoutPtr->chunks;
2820 baseline = chunkPtr->y;
2821 used = 0;
2822 buf[used++] = '[';
2823 buf[used++] = '(';
2824 for (i = 0; i < layoutPtr->numChunks; i++) {
2825 if (baseline != chunkPtr->y) {
2826 buf[used++] = ')';
2827 buf[used++] = ']';
2828 buf[used++] = '\n';
2829 buf[used++] = '[';
2830 buf[used++] = '(';
2831 baseline = chunkPtr->y;
2832 }
2833 if (chunkPtr->numDisplayChars <= 0) {
2834 if (chunkPtr->start[0] == '\t') {
2835 buf[used++] = '\\';
2836 buf[used++] = 't';
2837 }
2838 } else {
2839 p = chunkPtr->start;
2840 for (j = 0; j < chunkPtr->numDisplayChars; j++) {
2841 /*
2842 * INTL: For now we just treat the characters as binary
2843 * data and display the lower byte. Eventually this should
2844 * be revised to handle international postscript fonts.
2845 */
2846 last_p=p;
2847 p +=(charsize= Tcl_UtfToUniChar(p,&ch));
2848 Tcl_UtfToExternal(interp,NULL,last_p,charsize,0,NULL,one_char,4,
2849 NULL,&bytecount,NULL);
2850 if (bytecount == 1) {
2851 c = UCHAR(one_char[0]);
2852 /* c = UCHAR( ch & 0xFF) */;
2853 if ((c == '(') || (c == ')') || (c == '\\') || (c < 0x20)
2854 || (c >= UCHAR(0x7f))) {
2855 /*
2856 * Tricky point: the "03" is necessary in the sprintf
2857 * below, so that a full three digits of octal are
2858 * always generated. Without the "03", a number
2859 * following this sequence could be interpreted by
2860 * Postscript as part of this sequence.
2861 */
2862
2863 sprintf(buf + used, "\\%03o", c);
2864 used += 4;
2865 } else {
2866 buf[used++] = c;
2867 }
2868 } else {
2869 /* This character doesn't belong to system character set.
2870 * So, we must use full glyph name */
2871 sprintf(uindex,"%04X",ch); /* endianness? */
2872 if ((glyphname = Tcl_GetVar2( interp , "::tk::psglyphs",uindex,0))) {
2873 if (used > 0 && buf [used-1] == '(')
2874 --used;
2875 else
2876 buf[used++] = ')';
2877 buf[used++] = '/';
2878 while( (*glyphname) && (used < (MAXUSE+27)))
2879 buf[used++] = *glyphname++ ;
2880 buf[used++] = '(';
2881 }
2882 else {
2883 LangDebug("No PostScript glyph for U+%04x\n",ch);
2884 }
2885 }
2886 if (used >= MAXUSE) {
2887 buf[used] = '\0';
2888 Tcl_AppendResult(interp, buf, (char *) NULL);
2889 used = 0;
2890 }
2891 }
2892 }
2893 if (used >= MAXUSE) {
2894 /*
2895 * If there are a whole bunch of returns or tabs in a row,
2896 * then buf[] could get filled up.
2897 */
2898
2899 buf[used] = '\0';
2900 Tcl_AppendResult(interp, buf, (char *) NULL);
2901 used = 0;
2902 }
2903 chunkPtr++;
2904 }
2905 buf[used++] = ')';
2906 buf[used++] = ']';
2907 buf[used++] = '\n';
2908 buf[used] = '\0';
2909 Tcl_AppendResult(interp, buf, (char *) NULL);
2910 }
2911
2912 /*
2913 *---------------------------------------------------------------------------
2914 *
2915 * ConfigAttributesObj --
2916 *
2917 * Process command line options to fill in fields of a properly
2918 * initialized font attributes structure.
2919 *
2920 * Results:
2921 * A standard Tcl return value. If TCL_ERROR is returned, an
2922 * error message will be left in interp's result object.
2923 *
2924 * Side effects:
2925 * The fields of the font attributes structure get filled in with
2926 * information from argc/argv. If an error occurs while parsing,
2927 * the font attributes structure will contain all modifications
2928 * specified in the command line options up to the point of the
2929 * error.
2930 *
2931 *---------------------------------------------------------------------------
2932 */
2933
2934 static int
ConfigAttributesObj(interp,tkwin,objc,objv,faPtr)2935 ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
2936 Tcl_Interp *interp; /* Interp for error return. */
2937 Tk_Window tkwin; /* For display on which font will be used. */
2938 int objc; /* Number of elements in argv. */
2939 Tcl_Obj *CONST objv[]; /* Command line options. */
2940 TkFontAttributes *faPtr; /* Font attributes structure whose fields
2941 * are to be modified. Structure must already
2942 * be properly initialized. */
2943 {
2944 int i, n, index;
2945 Tcl_Obj *optionPtr, *valuePtr;
2946 char *value;
2947
2948 for (i = 0; i < objc; i += 2) {
2949 optionPtr = objv[i];
2950 valuePtr = objv[i + 1];
2951
2952 if (Tcl_GetIndexFromObj(interp, optionPtr, fontOpt, "option", 1,
2953 &index) != TCL_OK) {
2954 return TCL_ERROR;
2955 }
2956 if ((i+2 >= objc) && (objc & 1)) {
2957 /*
2958 * This test occurs after Tcl_GetIndexFromObj() so that
2959 * "font create xyz -xyz" will return the error message
2960 * that "-xyz" is a bad option, rather than that the value
2961 * for "-xyz" is missing.
2962 */
2963
2964 Tcl_AppendResult(interp, "value for \"",
2965 Tcl_GetString(optionPtr), "\" option missing",
2966 (char *) NULL);
2967 return TCL_ERROR;
2968 }
2969
2970 switch (index) {
2971 case FONT_FAMILY: {
2972 value = Tcl_GetString(valuePtr);
2973 faPtr->family = Tk_GetUid(value);
2974 break;
2975 }
2976 case FONT_SIZE: {
2977 if (Tcl_GetIntFromObj(interp, valuePtr, &n) != TCL_OK) {
2978 return TCL_ERROR;
2979 }
2980 faPtr->size = n;
2981 break;
2982 }
2983 case FONT_WEIGHT: {
2984 n = TkFindStateNumObj(interp, optionPtr, weightMap, valuePtr);
2985 if (n == TK_FW_UNKNOWN) {
2986 return TCL_ERROR;
2987 }
2988 faPtr->weight = n;
2989 break;
2990 }
2991 case FONT_SLANT: {
2992 n = TkFindStateNumObj(interp, optionPtr, slantMap, valuePtr);
2993 if (n == TK_FS_UNKNOWN) {
2994 return TCL_ERROR;
2995 }
2996 faPtr->slant = n;
2997 break;
2998 }
2999 case FONT_UNDERLINE: {
3000 if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
3001 return TCL_ERROR;
3002 }
3003 faPtr->underline = n;
3004 break;
3005 }
3006 case FONT_OVERSTRIKE: {
3007 if (Tcl_GetBooleanFromObj(interp, valuePtr, &n) != TCL_OK) {
3008 return TCL_ERROR;
3009 }
3010 faPtr->overstrike = n;
3011 break;
3012 }
3013 }
3014 }
3015 return TCL_OK;
3016 }
3017
3018 /*
3019 *---------------------------------------------------------------------------
3020 *
3021 * GetAttributeInfoObj --
3022 *
3023 * Return information about the font attributes as a Tcl list.
3024 *
3025 * Results:
3026 * The return value is TCL_OK if the objPtr was non-NULL and
3027 * specified a valid font attribute, TCL_ERROR otherwise. If TCL_OK
3028 * is returned, the interp's result object is modified to hold a
3029 * description of either the current value of a single option, or a
3030 * list of all options and their current values for the given font
3031 * attributes. If TCL_ERROR is returned, the interp's result is
3032 * set to an error message describing that the objPtr did not refer
3033 * to a valid option.
3034 *
3035 * Side effects:
3036 * None.
3037 *
3038 *---------------------------------------------------------------------------
3039 */
3040
3041 static int
GetAttributeInfoObj(interp,faPtr,objPtr)3042 GetAttributeInfoObj(interp, faPtr, objPtr)
3043 Tcl_Interp *interp; /* Interp to hold result. */
3044 CONST TkFontAttributes *faPtr; /* The font attributes to inspect. */
3045 Tcl_Obj *objPtr; /* If non-NULL, indicates the single
3046 * option whose value is to be
3047 * returned. Otherwise information is
3048 * returned for all options. */
3049 {
3050 int i, index, start, end;
3051 CONST char *str;
3052 Tcl_Obj *optionPtr, *valuePtr, *resultPtr;
3053
3054 resultPtr = Tcl_GetObjResult(interp);
3055
3056 start = 0;
3057 end = FONT_NUMFIELDS;
3058 if (objPtr != NULL) {
3059 if (Tcl_GetIndexFromObj(interp, objPtr, fontOpt, "option", TCL_EXACT,
3060 &index) != TCL_OK) {
3061 return TCL_ERROR;
3062 }
3063 start = index;
3064 end = index + 1;
3065 }
3066
3067 valuePtr = NULL;
3068 for (i = start; i < end; i++) {
3069 switch (i) {
3070 case FONT_FAMILY:
3071 str = faPtr->family;
3072 valuePtr = Tcl_NewStringObj(str, ((str == NULL) ? 0 : -1));
3073 break;
3074
3075 case FONT_SIZE:
3076 valuePtr = Tcl_NewIntObj(faPtr->size);
3077 break;
3078
3079 case FONT_WEIGHT:
3080 str = TkFindStateString(weightMap, faPtr->weight);
3081 valuePtr = Tcl_NewStringObj(str, -1);
3082 break;
3083
3084 case FONT_SLANT:
3085 str = TkFindStateString(slantMap, faPtr->slant);
3086 valuePtr = Tcl_NewStringObj(str, -1);
3087 break;
3088
3089 case FONT_UNDERLINE:
3090 valuePtr = Tcl_NewBooleanObj(faPtr->underline);
3091 break;
3092
3093 case FONT_OVERSTRIKE:
3094 valuePtr = Tcl_NewBooleanObj(faPtr->overstrike);
3095 break;
3096 }
3097 if (objPtr != NULL) {
3098 Tcl_SetObjResult(interp, valuePtr);
3099 return TCL_OK;
3100 }
3101 optionPtr = Tcl_NewStringObj(fontOpt[i], -1);
3102 Tcl_ListObjAppendElement(NULL, resultPtr, optionPtr);
3103 Tcl_ListObjAppendElement(NULL, resultPtr, valuePtr);
3104 }
3105 return TCL_OK;
3106 }
3107
3108 /*
3109 *---------------------------------------------------------------------------
3110 *
3111 * ParseFontNameObj --
3112 *
3113 * Converts a object into a set of font attributes that can be used
3114 * to construct a font.
3115 *
3116 * The string rep of the object can be one of the following forms:
3117 * XLFD (see X documentation)
3118 * "family [size] [style1 [style2 ...]"
3119 * "-option value [-option value ...]"
3120 *
3121 * Results:
3122 * The return value is TCL_ERROR if the object was syntactically
3123 * invalid. In that case an error message is left in interp's
3124 * result object. Otherwise, fills the font attribute buffer with
3125 * the values parsed from the string and returns TCL_OK;
3126 *
3127 * Side effects:
3128 * None.
3129 *
3130 *---------------------------------------------------------------------------
3131 */
3132
3133 static int
ParseFontNameObj(interp,tkwin,objPtr,faPtr)3134 ParseFontNameObj(interp, tkwin, objPtr, faPtr)
3135 Tcl_Interp *interp; /* Interp for error return. Must not be
3136 * NULL. */
3137 Tk_Window tkwin; /* For display on which font is used. */
3138 Tcl_Obj *objPtr; /* Parseable font description object. */
3139 TkFontAttributes *faPtr; /* Filled with attributes parsed from font
3140 * name. Any attributes that were not
3141 * specified in font name are filled with
3142 * default values. */
3143 {
3144 char *dash;
3145 int objc, result, i, n;
3146 Tcl_Obj **objv;
3147 char *string;
3148
3149 TkInitFontAttributes(faPtr);
3150
3151 string = Tcl_GetString(objPtr);
3152 if (*string == '-') {
3153 /*
3154 * This may be an XLFD or an "-option value" string.
3155 *
3156 * If the string begins with "-*" or a "-foundry-family-*" pattern,
3157 * then consider it an XLFD.
3158 */
3159
3160 if (string[1] == '*') {
3161 goto xlfd;
3162 }
3163 dash = strchr(string + 1, '-');
3164 if ((dash != NULL)
3165 && (!isspace(UCHAR(dash[-1])))) { /* INTL: ISO space */
3166 goto xlfd;
3167 }
3168
3169 if (Tcl_ListObjGetElements(interp, objPtr, &objc, &objv) != TCL_OK) {
3170 return TCL_ERROR;
3171 }
3172
3173 return ConfigAttributesObj(interp, tkwin, objc, objv, faPtr);
3174 }
3175
3176 if (*string == '*') {
3177 /*
3178 * This is appears to be an XLFD. Under Unix, all valid XLFDs were
3179 * already handled by TkpGetNativeFont. If we are here, either we
3180 * have something that initially looks like an XLFD but isn't or we
3181 * have encountered an XLFD on Windows or Mac.
3182 */
3183
3184 xlfd:
3185 result = TkFontParseXLFD(string, faPtr, NULL);
3186 if (result == TCL_OK) {
3187 return TCL_OK;
3188 }
3189 }
3190
3191 /*
3192 * Wasn't an XLFD or "-option value" string. Try it as a
3193 * "font size style" list.
3194 */
3195
3196 if ((Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv) != TCL_OK)
3197 || (objc < 1)) {
3198 Tcl_AppendResult(interp, "font \"", string, "\" doesn't exist",
3199 (char *) NULL);
3200 return TCL_ERROR;
3201 }
3202
3203 faPtr->family = Tk_GetUid(Tcl_GetString(objv[0]));
3204 if (objc > 1) {
3205 if (Tcl_GetIntFromObj(interp, objv[1], &n) != TCL_OK) {
3206 return TCL_ERROR;
3207 }
3208 faPtr->size = n;
3209 }
3210
3211 i = 2;
3212 if (objc == 3) {
3213 if (Tcl_ListObjGetElements(interp, objv[2], &objc, &objv) != TCL_OK) {
3214 return TCL_ERROR;
3215 }
3216 i = 0;
3217 }
3218 for ( ; i < objc; i++) {
3219 n = TkFindStateNumObj(NULL, NULL, weightMap, objv[i]);
3220 if (n != TK_FW_UNKNOWN) {
3221 faPtr->weight = n;
3222 continue;
3223 }
3224 n = TkFindStateNumObj(NULL, NULL, slantMap, objv[i]);
3225 if (n != TK_FS_UNKNOWN) {
3226 faPtr->slant = n;
3227 continue;
3228 }
3229 n = TkFindStateNumObj(NULL, NULL, underlineMap, objv[i]);
3230 if (n != 0) {
3231 faPtr->underline = n;
3232 continue;
3233 }
3234 n = TkFindStateNumObj(NULL, NULL, overstrikeMap, objv[i]);
3235 if (n != 0) {
3236 faPtr->overstrike = n;
3237 continue;
3238 }
3239
3240 /*
3241 * Unknown style.
3242 */
3243
3244 Tcl_AppendResult(interp, "unknown font style \"",
3245 Tcl_GetString(objv[i]), "\"", (char *) NULL);
3246 return TCL_ERROR;
3247 }
3248 return TCL_OK;
3249 }
3250
3251 /*
3252 *---------------------------------------------------------------------------
3253 *
3254 * NewChunk --
3255 *
3256 * Helper function for Tk_ComputeTextLayout(). Encapsulates a
3257 * measured set of characters in a chunk that can be quickly
3258 * drawn.
3259 *
3260 * Results:
3261 * A pointer to the new chunk in the text layout.
3262 *
3263 * Side effects:
3264 * The text layout is reallocated to hold more chunks as necessary.
3265 *
3266 * Currently, Tk_ComputeTextLayout() stores contiguous ranges of
3267 * "normal" characters in a chunk, along with individual tab
3268 * and newline chars in their own chunks. All characters in the
3269 * text layout are accounted for.
3270 *
3271 *---------------------------------------------------------------------------
3272 */
3273 static LayoutChunk *
NewChunk(layoutPtrPtr,maxPtr,start,numBytes,curX,newX,y)3274 NewChunk(layoutPtrPtr, maxPtr, start, numBytes, curX, newX, y)
3275 TextLayout **layoutPtrPtr;
3276 int *maxPtr;
3277 CONST char *start;
3278 int numBytes;
3279 int curX;
3280 int newX;
3281 int y;
3282 {
3283 TextLayout *layoutPtr;
3284 LayoutChunk *chunkPtr;
3285 int maxChunks, numChars;
3286 size_t s;
3287
3288 layoutPtr = *layoutPtrPtr;
3289 maxChunks = *maxPtr;
3290 if (layoutPtr->numChunks == maxChunks) {
3291 maxChunks *= 2;
3292 s = sizeof(TextLayout) + ((maxChunks - 1) * sizeof(LayoutChunk));
3293 layoutPtr = (TextLayout *) ckrealloc((char *) layoutPtr, s);
3294
3295 *layoutPtrPtr = layoutPtr;
3296 *maxPtr = maxChunks;
3297 }
3298 numChars = Tcl_NumUtfChars(start, numBytes);
3299 chunkPtr = &layoutPtr->chunks[layoutPtr->numChunks];
3300 chunkPtr->start = start;
3301 chunkPtr->numBytes = numBytes;
3302 chunkPtr->numChars = numChars;
3303 chunkPtr->numDisplayChars = numChars;
3304 chunkPtr->x = curX;
3305 chunkPtr->y = y;
3306 chunkPtr->totalWidth = newX - curX;
3307 chunkPtr->displayWidth = newX - curX;
3308 layoutPtr->numChunks++;
3309
3310 return chunkPtr;
3311 }
3312
3313 /*
3314 *---------------------------------------------------------------------------
3315 *
3316 * TkFontParseXLFD --
3317 *
3318 * Break up a fully specified XLFD into a set of font attributes.
3319 *
3320 * Results:
3321 * Return value is TCL_ERROR if string was not a fully specified XLFD.
3322 * Otherwise, fills font attribute buffer with the values parsed
3323 * from the XLFD and returns TCL_OK.
3324 *
3325 * Side effects:
3326 * None.
3327 *
3328 *---------------------------------------------------------------------------
3329 */
3330
3331 int
TkFontParseXLFD(string,faPtr,xaPtr)3332 TkFontParseXLFD(string, faPtr, xaPtr)
3333 CONST char *string; /* Parseable font description string. */
3334 TkFontAttributes *faPtr; /* Filled with attributes parsed from font
3335 * name. Any attributes that were not
3336 * specified in font name are filled with
3337 * default values. */
3338 TkXLFDAttributes *xaPtr; /* Filled with X-specific attributes parsed
3339 * from font name. Any attributes that were
3340 * not specified in font name are filled with
3341 * default values. May be NULL if such
3342 * information is not desired. */
3343 {
3344 char *src;
3345 CONST char *str;
3346 int i, j;
3347 char *field[XLFD_NUMFIELDS + 2];
3348 Tcl_DString ds;
3349 TkXLFDAttributes xa;
3350
3351 if (xaPtr == NULL) {
3352 xaPtr = &xa;
3353 }
3354 TkInitFontAttributes(faPtr);
3355 TkInitXLFDAttributes(xaPtr);
3356
3357 memset(field, '\0', sizeof(field));
3358
3359 if (!(str = string)) {
3360 return TCL_ERROR;
3361 }
3362 if (*str == '-') {
3363 str++;
3364 }
3365
3366 Tcl_DStringInit(&ds);
3367 Tcl_DStringAppend(&ds, (char *) str, -1);
3368 src = Tcl_DStringValue(&ds);
3369
3370 field[0] = src;
3371 for (i = 0; *src != '\0'; src++) {
3372 if (!(*src & 0x80)
3373 && Tcl_UniCharIsUpper(UCHAR(*src))) {
3374 *src = (char) Tcl_UniCharToLower(UCHAR(*src));
3375 }
3376 if (*src == '-') {
3377 i++;
3378 if (i == XLFD_NUMFIELDS) {
3379 continue;
3380 }
3381 *src = '\0';
3382 field[i] = src + 1;
3383 if (i > XLFD_NUMFIELDS) {
3384 break;
3385 }
3386 }
3387 }
3388
3389 /*
3390 * An XLFD of the form -adobe-times-medium-r-*-12-*-* is pretty common,
3391 * but it is (strictly) malformed, because the first * is eliding both
3392 * the Setwidth and the Addstyle fields. If the Addstyle field is a
3393 * number, then assume the above incorrect form was used and shift all
3394 * the rest of the fields right by one, so the number gets interpreted
3395 * as a pixelsize. This fix is so that we don't get a million reports
3396 * that "it works under X (as a native font name), but gives a syntax
3397 * error under Windows (as a parsed set of attributes)".
3398 */
3399
3400 if ((i > XLFD_ADD_STYLE) && (FieldSpecified(field[XLFD_ADD_STYLE]))) {
3401 if (atoi(field[XLFD_ADD_STYLE]) != 0) {
3402 for (j = XLFD_NUMFIELDS - 1; j >= XLFD_ADD_STYLE; j--) {
3403 field[j + 1] = field[j];
3404 }
3405 field[XLFD_ADD_STYLE] = NULL;
3406 i++;
3407 }
3408 }
3409
3410 /*
3411 * Bail if we don't have enough of the fields (up to pointsize).
3412 */
3413
3414 if (i < XLFD_FAMILY) {
3415 Tcl_DStringFree(&ds);
3416 return TCL_ERROR;
3417 }
3418
3419 if (FieldSpecified(field[XLFD_FOUNDRY])) {
3420 xaPtr->foundry = Tk_GetUid(field[XLFD_FOUNDRY]);
3421 }
3422
3423 if (FieldSpecified(field[XLFD_FAMILY])) {
3424 faPtr->family = Tk_GetUid(field[XLFD_FAMILY]);
3425 }
3426 if (FieldSpecified(field[XLFD_WEIGHT])) {
3427 faPtr->weight = TkFindStateNum(NULL, NULL, xlfdWeightMap,
3428 field[XLFD_WEIGHT]);
3429 }
3430 if (FieldSpecified(field[XLFD_SLANT])) {
3431 xaPtr->slant = TkFindStateNum(NULL, NULL, xlfdSlantMap,
3432 field[XLFD_SLANT]);
3433 if (xaPtr->slant == TK_FS_ROMAN) {
3434 faPtr->slant = TK_FS_ROMAN;
3435 } else {
3436 faPtr->slant = TK_FS_ITALIC;
3437 }
3438 }
3439 if (FieldSpecified(field[XLFD_SETWIDTH])) {
3440 xaPtr->setwidth = TkFindStateNum(NULL, NULL, xlfdSetwidthMap,
3441 field[XLFD_SETWIDTH]);
3442 }
3443
3444 /* XLFD_ADD_STYLE ignored. */
3445
3446 /*
3447 * Pointsize in tenths of a point, but treat it as tenths of a pixel
3448 * for historical compatibility.
3449 */
3450
3451 faPtr->size = 12;
3452
3453 if (FieldSpecified(field[XLFD_POINT_SIZE])) {
3454 if (field[XLFD_POINT_SIZE][0] == '[') {
3455 /*
3456 * Some X fonts have the point size specified as follows:
3457 *
3458 * [ N1 N2 N3 N4 ]
3459 *
3460 * where N1 is the point size (in points, not decipoints!), and
3461 * N2, N3, and N4 are some additional numbers that I don't know
3462 * the purpose of, so I ignore them.
3463 */
3464
3465 faPtr->size = atoi(field[XLFD_POINT_SIZE] + 1);
3466 } else if (Tcl_GetInt(NULL, field[XLFD_POINT_SIZE],
3467 &faPtr->size) == TCL_OK) {
3468 faPtr->size /= 10;
3469 } else {
3470 return TCL_ERROR;
3471 }
3472 }
3473
3474 /*
3475 * Pixel height of font. If specified, overrides pointsize.
3476 */
3477
3478 if (FieldSpecified(field[XLFD_PIXEL_SIZE])) {
3479 if (field[XLFD_PIXEL_SIZE][0] == '[') {
3480 /*
3481 * Some X fonts have the pixel size specified as follows:
3482 *
3483 * [ N1 N2 N3 N4 ]
3484 *
3485 * where N1 is the pixel size, and where N2, N3, and N4
3486 * are some additional numbers that I don't know
3487 * the purpose of, so I ignore them.
3488 */
3489
3490 faPtr->size = atoi(field[XLFD_PIXEL_SIZE] + 1);
3491 } else if (Tcl_GetInt(NULL, field[XLFD_PIXEL_SIZE],
3492 &faPtr->size) != TCL_OK) {
3493 return TCL_ERROR;
3494 }
3495 }
3496
3497 faPtr->size = -faPtr->size;
3498
3499 /* XLFD_RESOLUTION_X ignored. */
3500
3501 /* XLFD_RESOLUTION_Y ignored. */
3502
3503 /* XLFD_SPACING ignored. */
3504
3505 /* XLFD_AVERAGE_WIDTH ignored. */
3506
3507 if (FieldSpecified(field[XLFD_CHARSET])) {
3508 xaPtr->charset = Tk_GetUid(field[XLFD_CHARSET]);
3509 } else {
3510 xaPtr->charset = Tk_GetUid("iso8859-1");
3511 }
3512 Tcl_DStringFree(&ds);
3513 return TCL_OK;
3514 }
3515
3516 /*
3517 *---------------------------------------------------------------------------
3518 *
3519 * FieldSpecified --
3520 *
3521 * Helper function for TkParseXLFD(). Determines if a field in the
3522 * XLFD was set to a non-null, non-don't-care value.
3523 *
3524 * Results:
3525 * The return value is 0 if the field in the XLFD was not set and
3526 * should be ignored, non-zero otherwise.
3527 *
3528 * Side effects:
3529 * None.
3530 *
3531 *---------------------------------------------------------------------------
3532 */
3533
3534 static int
FieldSpecified(field)3535 FieldSpecified(field)
3536 CONST char *field; /* The field of the XLFD to check. Strictly
3537 * speaking, only when the string is "*" does it mean
3538 * don't-care. However, an unspecified or question
3539 * mark is also interpreted as don't-care. */
3540 {
3541 char ch;
3542
3543 if (field == NULL) {
3544 return 0;
3545 }
3546 ch = field[0];
3547 return (ch != '*' && ch != '?');
3548 }
3549
3550 /*
3551 *---------------------------------------------------------------------------
3552 *
3553 * TkFontGetPixels --
3554 *
3555 * Given a font size specification (as described in the TkFontAttributes
3556 * structure) return the number of pixels it represents.
3557 *
3558 * Results:
3559 * As above.
3560 *
3561 * Side effects:
3562 * None.
3563 *
3564 *---------------------------------------------------------------------------
3565 */
3566
3567 int
TkFontGetPixels(screen,size)3568 TkFontGetPixels(screen, size)
3569 Screen *screen; /* For point->pixel conversion factor. */
3570 int size; /* Font size. */
3571 {
3572 double d;
3573
3574 if (size < 0) {
3575 return -size;
3576 }
3577
3578 d = size * 25.4 / 72.0;
3579 d *= WidthOfScreen(screen);
3580 d /= WidthMMOfScreen(screen);
3581 return (int) (d + 0.5);
3582 }
3583
3584 /*
3585 *---------------------------------------------------------------------------
3586 *
3587 * TkFontGetPoints --
3588 *
3589 * Given a font size specification (as described in the TkFontAttributes
3590 * structure) return the number of points it represents.
3591 *
3592 * Results:
3593 * As above.
3594 *
3595 * Side effects:
3596 * None.
3597 *
3598 *---------------------------------------------------------------------------
3599 */
3600
3601 int
TkFontGetPoints(screen,size)3602 TkFontGetPoints(screen, size)
3603 Screen *screen; /* For pixel->point conversion factor. */
3604 int size; /* Font size. */
3605 {
3606 double d;
3607
3608 if (size >= 0) {
3609 return size;
3610 }
3611
3612 d = -size * 72.0 / 25.4;
3613 d *= WidthMMOfScreen(screen);
3614 d /= WidthOfScreen(screen);
3615 return (int) (d + 0.5);
3616 }
3617
3618 /*
3619 *-------------------------------------------------------------------------
3620 *
3621 * TkFontGetAliasList --
3622 *
3623 * Given a font name, find the list of all aliases for that font
3624 * name. One of the names in this list will probably be the name
3625 * that this platform expects when asking for the font.
3626 *
3627 * Results:
3628 * As above. The return value is NULL if the font name has no
3629 * aliases.
3630 *
3631 * Side effects:
3632 * None.
3633 *
3634 *-------------------------------------------------------------------------
3635 */
3636
3637 char **
TkFontGetAliasList(faceName)3638 TkFontGetAliasList(faceName)
3639 CONST char *faceName; /* Font name to test for aliases. */
3640 {
3641 int i, j;
3642
3643 for (i = 0; fontAliases[i] != NULL; i++) {
3644 for (j = 0; fontAliases[i][j] != NULL; j++) {
3645 if (strcasecmp(faceName, fontAliases[i][j]) == 0) {
3646 return fontAliases[i];
3647 }
3648 }
3649 }
3650 return NULL;
3651 }
3652
3653 /*
3654 *-------------------------------------------------------------------------
3655 *
3656 * TkFontGetFallbacks --
3657 *
3658 * Get the list of font fallbacks that the platform-specific code
3659 * can use to try to find the closest matching font the name
3660 * requested.
3661 *
3662 * Results:
3663 * As above.
3664 *
3665 * Side effects:
3666 * None.
3667 *
3668 *-------------------------------------------------------------------------
3669 */
3670
3671 char ***
TkFontGetFallbacks()3672 TkFontGetFallbacks()
3673 {
3674 return fontFallbacks;
3675 }
3676
3677 /*
3678 *-------------------------------------------------------------------------
3679 *
3680 * TkFontGetGlobalClass --
3681 *
3682 * Get the list of fonts to try if the requested font name does not
3683 * exist and no fallbacks for that font name could be used either.
3684 * The names in this list are considered preferred over all the other
3685 * font names in the system when looking for a last-ditch fallback.
3686 *
3687 * Results:
3688 * As above.
3689 *
3690 * Side effects:
3691 * None.
3692 *
3693 *-------------------------------------------------------------------------
3694 */
3695
3696 char **
TkFontGetGlobalClass()3697 TkFontGetGlobalClass()
3698 {
3699 return globalFontClass;
3700 }
3701
3702 /*
3703 *-------------------------------------------------------------------------
3704 *
3705 * TkFontGetSymbolClass --
3706 *
3707 * Get the list of fonts that are symbolic; used if the operating
3708 * system cannot apriori identify symbolic fonts on its own.
3709 *
3710 * Results:
3711 * As above.
3712 *
3713 * Side effects:
3714 * None.
3715 *
3716 *-------------------------------------------------------------------------
3717 */
3718
3719 char **
TkFontGetSymbolClass()3720 TkFontGetSymbolClass()
3721 {
3722 return symbolClass;
3723 }
3724
3725 /*
3726 *----------------------------------------------------------------------
3727 *
3728 * TkDebugFont --
3729 *
3730 * This procedure returns debugging information about a font.
3731 *
3732 * Results:
3733 * The return value is a list with one sublist for each TkFont
3734 * corresponding to "name". Each sublist has two elements that
3735 * contain the resourceRefCount and objRefCount fields from the
3736 * TkFont structure.
3737 *
3738 * Side effects:
3739 * None.
3740 *
3741 *----------------------------------------------------------------------
3742 */
3743
3744 Tcl_Obj *
TkDebugFont(tkwin,name)3745 TkDebugFont(tkwin, name)
3746 Tk_Window tkwin; /* The window in which the font will be
3747 * used (not currently used). */
3748 char *name; /* Name of the desired color. */
3749 {
3750 TkFont *fontPtr;
3751 Tcl_HashEntry *hashPtr;
3752 Tcl_Obj *resultPtr, *objPtr;
3753
3754 resultPtr = Tcl_NewObj();
3755 hashPtr = Tcl_FindHashEntry(
3756 &((TkWindow *) tkwin)->mainPtr->fontInfoPtr->fontCache, name);
3757 if (hashPtr != NULL) {
3758 fontPtr = (TkFont *) Tcl_GetHashValue(hashPtr);
3759 if (fontPtr == NULL) {
3760 panic("TkDebugFont found empty hash table entry");
3761 }
3762 for ( ; (fontPtr != NULL); fontPtr = fontPtr->nextPtr) {
3763 objPtr = Tcl_NewObj();
3764 Tcl_ListObjAppendElement(NULL, objPtr,
3765 Tcl_NewIntObj(fontPtr->resourceRefCount));
3766 Tcl_ListObjAppendElement(NULL, objPtr,
3767 Tcl_NewIntObj(fontPtr->objRefCount));
3768 Tcl_ListObjAppendElement(NULL, resultPtr, objPtr);
3769 }
3770 }
3771 return resultPtr;
3772 }
3773
3774 /*
3775 *----------------------------------------------------------------------
3776 *
3777 * TkFontGetFirstTextLayout --
3778 *
3779 * This procedure returns the first chunk of a Tk_TextLayout,
3780 * i.e. until the first font change on the first line (or the
3781 * whole first line if there is no such font change).
3782 *
3783 * Results:
3784 * The return value is the byte length of the chunk, the chunk
3785 * itself is copied into dst and its Tk_Font into font.
3786 *
3787 * Side effects:
3788 * None.
3789 *
3790 *----------------------------------------------------------------------
3791 */
3792
3793 int
TkFontGetFirstTextLayout(Tk_TextLayout layout,Tk_Font * font,char * dst)3794 TkFontGetFirstTextLayout(
3795 Tk_TextLayout layout, /* Layout information, from a previous call
3796 * to Tk_ComputeTextLayout(). */
3797 Tk_Font * font,
3798 char * dst)
3799 {
3800 TextLayout *layoutPtr;
3801 LayoutChunk *chunkPtr;
3802 int numBytesInChunk;
3803
3804 layoutPtr = (TextLayout *)layout;
3805 if ((layoutPtr==NULL)
3806 || (layoutPtr->numChunks==0)
3807 || (layoutPtr->chunks->numDisplayChars <= 0)) {
3808 dst[0] = '\0';
3809 return 0;
3810 }
3811 chunkPtr = layoutPtr->chunks;
3812 numBytesInChunk = chunkPtr->numBytes;
3813 strncpy(dst, chunkPtr->start, (size_t) numBytesInChunk);
3814 *font = layoutPtr->tkfont;
3815 return numBytesInChunk;
3816 }
3817
3818