/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkfont.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkfont.c

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25