Tk Source Code

Changes On Branch tip-642
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-642 Excluding Merge-Ins

This is equivalent to a diff from 1bcc6791 to 0345621e

2022-10-21
22:11
TIP #642 implementation: Let TK_OPTION_BOOL/TK_OPTION_STRING_TABLE handle (C99) bool/enum check-in: ab731608 user: jan.nijtmans tags: trunk, main
2022-10-20
15:19
Merge 8.7 Leaf check-in: e8f2b9e9 user: jan.nijtmans tags: pspjuth-touch
15:13
Merge 8.7 check-in: dda1d0a2 user: jan.nijtmans tags: tcl8-compat
15:13
Merge 8.7 Closed-Leaf check-in: 0345621e user: jan.nijtmans tags: tip-642
14:56
Merge 8.7 check-in: a063a025 user: jan.nijtmans tags: tip-645
2022-10-19
10:48
Merge 8.7 Leaf check-in: 8e0e221c user: jan.nijtmans tags: tip-561
09:38
Alternative implementation of TIP #561 that uses Tcl's auto load functionality. check-in: 2acb0622 user: sbron tags: tip-561-autoload
2022-10-18
20:16
merge trunk check-in: 31fb16d2 user: fvogel tags: revised_text, tip-466
20:15
merge 8.6 check-in: 1bcc6791 user: fvogel tags: trunk, main
2022-10-17
20:45
Add a few more test adjustments check-in: 87d8b0cd user: culler tags: core-8-6-branch
20:07
Resolve duplicate test names in treeview.test. check-in: 4e285964 user: fvogel tags: trunk, main
2022-10-13
22:25
Merge 8.7 check-in: ed1e416f user: jan.nijtmans tags: tip-642

Changes to doc/SetOptions.3.

316
317
318
319
320
321
322











323
324
325
326
327
328
329
.TP
\fBTK_OPTION_DONT_SET_DEFAULT\fR
If this bit is set for an option then no default value will be set in
\fBTk_InitOptions\fR for this option. Neither the option database, nor any
system default value, nor \fIoptionTable\fR are used to give a default
value to this option. Instead it is assumed that the caller has already
supplied a default value in the widget code.











.PP
The \fItype\fR field of each Tk_OptionSpec structure determines
how to parse the value of that configuration option. The
legal value for \fItype\fR, and the corresponding actions, are
described below.  If the type requires a \fItkwin\fR value to be
passed into procedures like \fBTk_SetOptions\fR, or if it uses
the \fIclientData\fR field of the Tk_OptionSpec, then it is indicated






>
>
>
>
>
>
>
>
>
>
>







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
.TP
\fBTK_OPTION_DONT_SET_DEFAULT\fR
If this bit is set for an option then no default value will be set in
\fBTk_InitOptions\fR for this option. Neither the option database, nor any
system default value, nor \fIoptionTable\fR are used to give a default
value to this option. Instead it is assumed that the caller has already
supplied a default value in the widget code.
.TP
\fBTK_OPTION_ENUM_VAR\fR
If this value is set for an option, then it indicates the the
internalOffset points to an enum variable in stead of an int variable.
Only useful in combination with \fBTK_OPTION_STRING_TABLE\fR
.TP
\fBTK_OPTION_VAR(type)\fR
If this value is set for an option, then it indicates the the
internalOffset points to a \fItype\fR variable in stead of an int variable.
Only useful in combination with \fBTK_OPTION_STRING_TABLE\fR or
\fBTK_OPTION_BOOLEAN\fR
.PP
The \fItype\fR field of each Tk_OptionSpec structure determines
how to parse the value of that configuration option. The
legal value for \fItype\fR, and the corresponding actions, are
described below.  If the type requires a \fItkwin\fR value to be
passed into procedures like \fBTk_SetOptions\fR, or if it uses
the \fIclientData\fR field of the Tk_OptionSpec, then it is indicated

Changes to generic/tk.h.

226
227
228
229
230
231
232


233
234
235
236
237
238
239
/*
 * Flag values for Tk_OptionSpec structures. These flags are shared by
 * Tk_ConfigSpec structures, so be sure to coordinate any changes carefully.
 */

#define TK_OPTION_NULL_OK		(1 << 0)
#define TK_OPTION_DONT_SET_DEFAULT	(1 << 3)



/*
 * The following structure and function types are used by TK_OPTION_CUSTOM
 * options; the structure holds pointers to the functions needed by the Tk
 * option config code to handle a custom option.
 */







>
>







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
/*
 * Flag values for Tk_OptionSpec structures. These flags are shared by
 * Tk_ConfigSpec structures, so be sure to coordinate any changes carefully.
 */

#define TK_OPTION_NULL_OK		(1 << 0)
#define TK_OPTION_DONT_SET_DEFAULT	(1 << 3)
#define TK_OPTION_VAR(type)		((int)(sizeof(type)&(sizeof(int)-1))<<6)
#define TK_OPTION_ENUM_VAR		TK_OPTION_VAR(Tk_OptionType)

/*
 * The following structure and function types are used by TK_OPTION_CUSTOM
 * options; the structure holds pointers to the functions needed by the Tk
 * option config code to handle a custom option.
 */

Changes to generic/tkConfig.c.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
#define __NO_OLD_CONFIG
#endif

#include "tkInt.h"
#include "tkFont.h"

/*
 * The following encoding is used in TYPE_FLAGS:
 *
 * if sizeof(type) == sizeof(int)     =>    TYPE_FLAGS(type) = 0
 * if sizeof(type) == 1               =>    TYPE_FLAGS(type) = 64
 * if sizeof(type) == 2               =>    TYPE_FLAGS(type) = 128
 */
#define TYPE_FLAGS(type) (((int)(sizeof(type)&(sizeof(int)-1))<<6))
#define TYPE_MASK        (((((int)sizeof(int)-1))|3)<<6)

/*
 * The following definition keeps track of all of
 * the option tables that have been created for a thread.
 */







|

|
|
|

<







23
24
25
26
27
28
29
30
31
32
33
34
35

36
37
38
39
40
41
42
#define __NO_OLD_CONFIG
#endif

#include "tkInt.h"
#include "tkFont.h"

/*
 * The following encoding is used in TK_OPTION_VAR:
 *
 * if sizeof(type) == sizeof(int)     =>    TK_OPTION_VAR(type) = 0
 * if sizeof(type) == 1               =>    TK_OPTION_VAR(type) = 64
 * if sizeof(type) == 2               =>    TK_OPTION_VAR(type) = 128
 */

#define TYPE_MASK        (((((int)sizeof(int)-1))|3)<<6)

/*
 * The following definition keeps track of all of
 * the option tables that have been created for a thread.
 */

631
632
633
634
635
636
637











638
639

640
641
642
643
644
645
646
	    if (nullOK && interp) {
		Tcl_AppendResult(interp, "expected boolean value or \"\" but got \"",
			Tcl_GetString(valuePtr), "\"", NULL);
	    }
	    return TCL_ERROR;
	}
	if (internalPtr != NULL) {











	    *((int *) oldInternalPtr) = *((int *) internalPtr);
	    *((int *) internalPtr) = newBool;

	}
	break;
    }
    case TK_OPTION_INT: {
	int newInt;

	if (nullOK && ObjectIsEmpty(valuePtr)) {






>
>
>
>
>
>
>
>
>
>
>
|
|
>







630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
	    if (nullOK && interp) {
		Tcl_AppendResult(interp, "expected boolean value or \"\" but got \"",
			Tcl_GetString(valuePtr), "\"", NULL);
	    }
	    return TCL_ERROR;
	}
	if (internalPtr != NULL) {
	    if (optionPtr->specPtr->flags & TYPE_MASK) {
		if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(char)) {
		    *((char *) oldInternalPtr) = *((char *) internalPtr);
		    *((char *) internalPtr) = newBool;
		} else if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(short)) {
		    *((short *) oldInternalPtr) = *((short *) internalPtr);
		    *((short *) internalPtr) = newBool;
		} else {
		    Tcl_Panic("Invalid flags for %s", "TK_OPTION_BOOLEAN");
		}
	    } else {
		*((int *) oldInternalPtr) = *((int *) internalPtr);
		*((int *) internalPtr) = newBool;
	    }
	}
	break;
    }
    case TK_OPTION_INT: {
	int newInt;

	if (nullOK && ObjectIsEmpty(valuePtr)) {
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
		    optionPtr->specPtr->clientData, sizeof(char *),
		    optionPtr->specPtr->optionName+1, (nullOK ? TCL_NULL_OK : 0), &newValue) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	if (internalPtr != NULL) {
	    if (optionPtr->specPtr->flags & TYPE_MASK) {
		if ((optionPtr->specPtr->flags & TYPE_MASK) == TYPE_FLAGS(char)) {
		    *((char *) oldInternalPtr) = *((char *) internalPtr);
		    *((char *) internalPtr) = newValue;
		} else if ((optionPtr->specPtr->flags & TYPE_MASK) == TYPE_FLAGS(short)) {
		    *((short *) oldInternalPtr) = *((short *) internalPtr);
		    *((short *) internalPtr) = newValue;
		} else {
		    Tcl_Panic("Invalid flags for %s", "TK_OPTION_STRING_TABLE");
		}
	    } else {
		*((int *) oldInternalPtr) = *((int *) internalPtr);






|


|







757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
		    optionPtr->specPtr->clientData, sizeof(char *),
		    optionPtr->specPtr->optionName+1, (nullOK ? TCL_NULL_OK : 0), &newValue) != TCL_OK) {
		return TCL_ERROR;
	    }
	}
	if (internalPtr != NULL) {
	    if (optionPtr->specPtr->flags & TYPE_MASK) {
		if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(char)) {
		    *((char *) oldInternalPtr) = *((char *) internalPtr);
		    *((char *) internalPtr) = newValue;
		} else if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(short)) {
		    *((short *) oldInternalPtr) = *((short *) internalPtr);
		    *((short *) internalPtr) = newValue;
		} else {
		    Tcl_Panic("Invalid flags for %s", "TK_OPTION_STRING_TABLE");
		}
	    } else {
		*((int *) oldInternalPtr) = *((int *) internalPtr);
1477
1478
1479
1480
1481
1482
1483












1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
	}
	if (specPtr->internalOffset != TCL_INDEX_NONE) {
	    char *ptr = (char *) &savePtr->items[i].internalForm;

	    CLANG_ASSERT(internalPtr);
	    switch (specPtr->type) {
	    case TK_OPTION_BOOLEAN:












	    case TK_OPTION_INT:
	    case TK_OPTION_INDEX:
		*((int *) internalPtr) = *((int *) ptr);
		break;
	    case TK_OPTION_DOUBLE:
		*((double *) internalPtr) = *((double *) ptr);
		break;
	    case TK_OPTION_STRING:
		*((char **) internalPtr) = *((char **) ptr);
		break;
	    case TK_OPTION_STRING_TABLE:
		if (optionPtr->specPtr->flags & TYPE_MASK) {
		    if ((optionPtr->specPtr->flags & TYPE_MASK) == TYPE_FLAGS(char)) {
			*((char *) internalPtr) = *((char *) ptr);
		    } else if ((optionPtr->specPtr->flags & TYPE_MASK) == TYPE_FLAGS(short)) {
			*((short *) internalPtr) = *((short *) ptr);
		    } else {
			Tcl_Panic("Invalid flags for %s", "TK_OPTION_STRING_TABLE");
		    }
		} else {
		    *((int *) internalPtr) = *((int *) ptr);
		}






>
>
>
>
>
>
>
>
>
>
>
>












|

|







1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
	}
	if (specPtr->internalOffset != TCL_INDEX_NONE) {
	    char *ptr = (char *) &savePtr->items[i].internalForm;

	    CLANG_ASSERT(internalPtr);
	    switch (specPtr->type) {
	    case TK_OPTION_BOOLEAN:
		if (optionPtr->specPtr->flags & TYPE_MASK) {
		    if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(char)) {
			*((char *) internalPtr) = *((char *) ptr);
		    } else if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(short)) {
			*((short *) internalPtr) = *((short *) ptr);
		    } else {
			Tcl_Panic("Invalid flags for %s", "TK_OPTION_BOOLEAN");
		    }
		} else {
		    *((int *) internalPtr) = *((int *) ptr);
		}
		break;
	    case TK_OPTION_INT:
	    case TK_OPTION_INDEX:
		*((int *) internalPtr) = *((int *) ptr);
		break;
	    case TK_OPTION_DOUBLE:
		*((double *) internalPtr) = *((double *) ptr);
		break;
	    case TK_OPTION_STRING:
		*((char **) internalPtr) = *((char **) ptr);
		break;
	    case TK_OPTION_STRING_TABLE:
		if (optionPtr->specPtr->flags & TYPE_MASK) {
		    if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(char)) {
			*((char *) internalPtr) = *((char *) ptr);
		    } else if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(short)) {
			*((short *) internalPtr) = *((short *) ptr);
		    } else {
			Tcl_Panic("Invalid flags for %s", "TK_OPTION_STRING_TABLE");
		    }
		} else {
		    *((int *) internalPtr) = *((int *) ptr);
		}
1956
1957
1958
1959
1960
1961
1962
1963





1964







1965
1966
1967

1968
1969
1970
1971
1972
1973
1974
{
    Tcl_Obj *objPtr = NULL;
    void *internalPtr;		/* Points to internal value of option in record. */

    if (optionPtr->specPtr->internalOffset != TCL_INDEX_NONE) {
	internalPtr = (char *)recordPtr + optionPtr->specPtr->internalOffset;
	switch (optionPtr->specPtr->type) {
	case TK_OPTION_BOOLEAN:





	    if (*((int *) internalPtr) != -1) {







		objPtr = Tcl_NewBooleanObj(*((int *)internalPtr));
	    }
	    break;

	case TK_OPTION_INT:
	    if (!(optionPtr->specPtr->flags & (TK_OPTION_NULL_OK|TCL_NULL_OK)) || *((int *) internalPtr) != INT_MIN) {
		objPtr = Tcl_NewWideIntObj(*((int *)internalPtr));
	    }
	    break;
	case TK_OPTION_INDEX:
	    if (*((int *) internalPtr) == INT_MIN) {






|
>
>
>
>
>
|
>
>
>
>
>
>
>
|


>







1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
{
    Tcl_Obj *objPtr = NULL;
    void *internalPtr;		/* Points to internal value of option in record. */

    if (optionPtr->specPtr->internalOffset != TCL_INDEX_NONE) {
	internalPtr = (char *)recordPtr + optionPtr->specPtr->internalOffset;
	switch (optionPtr->specPtr->type) {
	case TK_OPTION_BOOLEAN: {
	    int value;
	    if (optionPtr->specPtr->flags & TYPE_MASK) {
		if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(char)) {
		    value = *((signed char *)internalPtr);
		} else if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(short)) {
		    value = *((short *)internalPtr);
		} else {
		    Tcl_Panic("Invalid flags for %s", "TK_OPTION_BOOLEAN");
		}
	    } else {
		value = *((int *)internalPtr);
	    }
	    if (value != -1) {
		objPtr = Tcl_NewBooleanObj(value);
	    }
	    break;
	}
	case TK_OPTION_INT:
	    if (!(optionPtr->specPtr->flags & (TK_OPTION_NULL_OK|TCL_NULL_OK)) || *((int *) internalPtr) != INT_MIN) {
		objPtr = Tcl_NewWideIntObj(*((int *)internalPtr));
	    }
	    break;
	case TK_OPTION_INDEX:
	    if (*((int *) internalPtr) == INT_MIN) {
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
	    break;
	case TK_OPTION_STRING:
	    objPtr = Tcl_NewStringObj(*((char **)internalPtr), -1);
	    break;
	case TK_OPTION_STRING_TABLE: {
	    int value;
	    if (optionPtr->specPtr->flags & TYPE_MASK) {
		if ((optionPtr->specPtr->flags & TYPE_MASK) == TYPE_FLAGS(char)) {
		    value = *((signed char *)internalPtr);
		} else if ((optionPtr->specPtr->flags & TYPE_MASK) == TYPE_FLAGS(short)) {
		    value = *((short *)internalPtr);
		} else {
		    Tcl_Panic("Invalid flags for %s", "TK_OPTION_STRING_TABLE");
		}
	    } else {
		value = *((int *)internalPtr);
	    }






|

|







2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
	    break;
	case TK_OPTION_STRING:
	    objPtr = Tcl_NewStringObj(*((char **)internalPtr), -1);
	    break;
	case TK_OPTION_STRING_TABLE: {
	    int value;
	    if (optionPtr->specPtr->flags & TYPE_MASK) {
		if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(char)) {
		    value = *((signed char *)internalPtr);
		} else if ((optionPtr->specPtr->flags & TYPE_MASK) == TK_OPTION_VAR(short)) {
		    value = *((short *)internalPtr);
		} else {
		    Tcl_Panic("Invalid flags for %s", "TK_OPTION_STRING_TABLE");
		}
	    } else {
		value = *((int *)internalPtr);
	    }

Changes to generic/tkEntry.c.

312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
	DEF_SPINBOX_VALUES, TCL_INDEX_NONE, offsetof(Spinbox, valueStr),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_SYNONYM, "-vcmd", NULL, NULL,
	NULL, 0, TCL_INDEX_NONE, 0, "-validatecommand", 0},
    {TK_OPTION_INT, "-width", "width", "Width",
	DEF_ENTRY_WIDTH, TCL_INDEX_NONE, offsetof(Entry, prefWidth), 0, 0, 0},
    {TK_OPTION_BOOLEAN, "-wrap", "wrap", "Wrap",
	DEF_SPINBOX_WRAP, TCL_INDEX_NONE, offsetof(Spinbox, wrap), 0, 0, 0},
    {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
	DEF_ENTRY_SCROLL_COMMAND, TCL_INDEX_NONE, offsetof(Entry, scrollCmd),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, TCL_INDEX_NONE, 0, 0, 0}
};

/*






|







312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
	DEF_SPINBOX_VALUES, TCL_INDEX_NONE, offsetof(Spinbox, valueStr),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_SYNONYM, "-vcmd", NULL, NULL,
	NULL, 0, TCL_INDEX_NONE, 0, "-validatecommand", 0},
    {TK_OPTION_INT, "-width", "width", "Width",
	DEF_ENTRY_WIDTH, TCL_INDEX_NONE, offsetof(Entry, prefWidth), 0, 0, 0},
    {TK_OPTION_BOOLEAN, "-wrap", "wrap", "Wrap",
	DEF_SPINBOX_WRAP, TCL_INDEX_NONE, offsetof(Spinbox, wrap), TK_OPTION_VAR(bool), 0, 0},
    {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
	DEF_ENTRY_SCROLL_COMMAND, TCL_INDEX_NONE, offsetof(Entry, scrollCmd),
	TK_OPTION_NULL_OK, 0, 0},
    {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, TCL_INDEX_NONE, 0, 0, 0}
};

/*

Changes to generic/tkEntry.h.

11
12
13
14
15
16
17

18
19
20
21
22
23
24
#ifndef _TKENTRY
#define _TKENTRY

#ifndef _TKINT
#include "tkInt.h"
#endif


enum EntryType {
    TK_ENTRY, TK_SPINBOX
};

/*
 * A data structure of the following type is kept for each Entry widget






>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
#ifndef _TKENTRY
#define _TKENTRY

#ifndef _TKINT
#include "tkInt.h"
#endif
#include <stdbool.h>

enum EntryType {
    TK_ENTRY, TK_SPINBOX
};

/*
 * A data structure of the following type is kept for each Entry widget
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
    char *command;		/* Command to invoke for spin buttons. NULL
				 * means no command to issue. */

    /*
     * Spinbox specific fields for use with configuration settings above.
     */

    int wrap;			/* whether to wrap around when spinning */

    int selElement;		/* currently selected control */
    int curElement;		/* currently mouseover control */

    int repeatDelay;		/* repeat delay */
    int repeatInterval;		/* repeat interval */







|







212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
    char *command;		/* Command to invoke for spin buttons. NULL
				 * means no command to issue. */

    /*
     * Spinbox specific fields for use with configuration settings above.
     */

    bool wrap;			/* whether to wrap around when spinning */

    int selElement;		/* currently selected control */
    int curElement;		/* currently mouseover control */

    int repeatDelay;		/* repeat delay */
    int repeatInterval;		/* repeat interval */

Changes to generic/tkInt.h.

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
#ifndef _TKINT
#define _TKINT

#ifndef _TKPORT
#include "tkPort.h"
#endif

#define TK_OPTION_ENUM_VAR		((int)(sizeof(Tk_OptionType)&(sizeof(int)-1))<<6)

/*
 * Ensure WORDS_BIGENDIAN is defined correctly:
 * Needs to happen here in addition to configure to work with fat compiles on
 * Darwin (where configure runs only once for multiple architectures).
 */

#ifdef HAVE_SYS_TYPES_H






<
<







15
16
17
18
19
20
21


22
23
24
25
26
27
28
#ifndef _TKINT
#define _TKINT

#ifndef _TKPORT
#include "tkPort.h"
#endif



/*
 * Ensure WORDS_BIGENDIAN is defined correctly:
 * Needs to happen here in addition to configure to work with fat compiles on
 * Darwin (where configure runs only once for multiple architectures).
 */

#ifdef HAVE_SYS_TYPES_H