Tk Source Code

Check-in [2322894e]
Login

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

Overview
Comment:The 'option readfile' sub-command should maintain existing list structure for values. Fix for [766ef52f31]. Cherrypick of [5550a1383b].
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256:2322894eb8c65456658a605656a74bbb757e9181e06c7fa1287bcdd8afb78484
User & Date: mistachkin 2018-11-10 19:43:33
References
2018-11-10
19:44 Closed ticket [766ef52f]: option readfile loses list structure plus 6 other changes artifact: b75adf3c user: mistachkin
Context
2018-11-11
07:03
Restore the appearance virtual events now that the crashes are fixed. check-in: 429f2f92 user: culler tags: trunk
2018-11-10
19:43
The 'option readfile' sub-command should maintain existing list structure for values. Fix for [766ef52f31]. Cherrypick of [5550a1383b]. check-in: 2322894e user: mistachkin tags: trunk
14:18
Remove new Mojave virtual events to register system appearance changes because Tk crashes unpredictably; window decotrations, menus and dialogs change when system appearance changes and virtual events are not required check-in: 4f09dd1f user: kevin_walzer tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkOption.c.

991
992
993
994
995
996
997



998
999
1000
1001
1002
1003
1004
....
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
	/*
	 * Skip white space between the name and the value.
	 */

	src++;
	while ((*src == ' ') || (*src == '\t')) {
	    src++;



	}
	if (*src == '\0') {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "missing value on line %d", lineNum));
	    Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "VALUE", NULL);
	    return TCL_ERROR;
	}
................................................................................
		    src += 2;
		    lineNum++;
		    continue;
		} else if (src[1] == 'n') {
		    src += 2;
		    *dst++ = '\n';
		    continue;
		} else if (src[1] == '\t' || src[1] == ' ' || src[1] == '\\') {
		    ++src;
		} else if (src[1] >= '0' && src[1] <= '3' && src[2] >= '0' &&
			src[2] <= '9' && src[3] >= '0' && src[3] <= '9') {
		    *dst++ = ((src[1]&7)<<6) | ((src[2]&7)<<3) | (src[3]&7);
		    src += 4;
		    continue;
		}







>
>
>







 







|







991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
....
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
	/*
	 * Skip white space between the name and the value.
	 */

	src++;
	while ((*src == ' ') || (*src == '\t')) {
	    src++;
	}
	if (*src == '\\' && (src[1] == '\t' || src[1] == ' ')) {
	    src++;
	}
	if (*src == '\0') {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "missing value on line %d", lineNum));
	    Tcl_SetErrorCode(interp, "TK", "OPTIONDB", "VALUE", NULL);
	    return TCL_ERROR;
	}
................................................................................
		    src += 2;
		    lineNum++;
		    continue;
		} else if (src[1] == 'n') {
		    src += 2;
		    *dst++ = '\n';
		    continue;
		} else if (src[1] == '\\') {
		    ++src;
		} else if (src[1] >= '0' && src[1] <= '3' && src[2] >= '0' &&
			src[2] <= '9' && src[3] >= '0' && src[3] <= '9') {
		    *dst++ = ((src[1]&7)<<6) | ((src[2]&7)<<3) | (src[3]&7);
		    src += 4;
		    continue;
		}

Changes to tests/option.test.

382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
...
410
411
412
413
414
415
416
















417
418
419
420
421
422
423
424
425
test option-15.6 {database files} -body {
    option read $option1
	option get . x6 color
} -result {}
test option-15.7 {database files} -body {
    option read $option1
	option get . x9 color
} -result " \t\\A\n"
test option-15.8 {database files} -body {
    option read $option1 widget foo
} -returnCodes error -result {wrong # args: should be "option readfile fileName ?priority?"}
test option-15.9 {database files} -body {
    option add *x3 burgundy
    catch {option read $option1 userDefault}
    option get . x3 color
................................................................................
    puts $file "*x7: true\n*x8: false"
    close $file
    option read $option4 userDefault
    list [option get . x7 color] [option get . x8 color]
} -cleanup {
    removeFile $option4
} -result {true false}

















deleteWindows

# cleanup
cleanupTests
return










|







 







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









382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
...
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
test option-15.6 {database files} -body {
    option read $option1
	option get . x6 color
} -result {}
test option-15.7 {database files} -body {
    option read $option1
	option get . x9 color
} -result " \\\t\\A\n"
test option-15.8 {database files} -body {
    option read $option1 widget foo
} -returnCodes error -result {wrong # args: should be "option readfile fileName ?priority?"}
test option-15.9 {database files} -body {
    option add *x3 burgundy
    catch {option read $option1 userDefault}
    option get . x3 color
................................................................................
    puts $file "*x7: true\n*x8: false"
    close $file
    option read $option4 userDefault
    list [option get . x7 color] [option get . x8 color]
} -cleanup {
    removeFile $option4
} -result {true false}

set opt162val {label {
  foo bar
}
}
set opt162list [split $opt162val \n]

test option-16.2 {ticket 766ef52f3} {
    set option5 [makeFile {} option.file4]
    set file [open $option5 w]
    fconfigure $file -translation crlf
    puts $file "*notok: $opt162list"
    close $file
    option read $option5 userDefault
    option get . notok notok
} $opt162list

deleteWindows

# cleanup
cleanupTests
return