Tcl Source Code

Check-in [f8252c427b]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Merge 8.7
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: f8252c427be2b48a4de687f0a3647811c222f7db0ebb7e7c7a166a30c925d8bf
User & Date: jan.nijtmans 2019-05-31 23:14:50
Context
2019-06-06
08:20
Merge 8.7, and add some more usage of TCL_INDEX_NONE/TCL_AUTO_LENGTH check-in: 68a11af555 user: jan.nijtmans tags: trunk
2019-06-02
10:29
merge trunk check-in: 88619d3220 user: dkf tags: tip-526
2019-05-31
23:14
Merge 8.7 check-in: f8252c427b user: jan.nijtmans tags: trunk
23:14
Merge 8.6 check-in: 856a391eaa user: jan.nijtmans tags: core-8-branch
12:50
TIP 537 implementation: Enable 64-bit indexes in regexp matching check-in: 6e8aae14c1 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tools/genStubs.tcl.

519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
...
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
		    set pad 28
		}
		append line $next
		set sep ", "
	    }
	    append line ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append line " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append line $sep
		set next {}
................................................................................
		    append text " "
		}
		append text [lindex $arg 1] [lindex $arg 2]
		set sep ", "
	    }
	    append text ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append text " TCL_FORMAT_PRINTF(" [expr [llength $args] - 1] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append text $sep [lindex $arg 0]
		if {[string index $text end] ne "*"} {






|







 







|







519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
...
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
		    set pad 28
		}
		append line $next
		set sep ", "
	    }
	    append line ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append line " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append line $sep
		set next {}
................................................................................
		    append text " "
		}
		append text [lindex $arg 1] [lindex $arg 2]
		set sep ", "
	    }
	    append text ", ...)"
	    if {[lindex $args end] eq "{const char *} format"} {
		append text " TCL_FORMAT_PRINTF(" [expr {[llength $args] - 1}] ", " [llength $args] ")"
	    }
	}
	default {
	    set sep "("
	    foreach arg $args {
		append text $sep [lindex $arg 0]
		if {[string index $text end] ne "*"} {

Changes to tools/man2help2.tcl.

823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
    } elseif {$length == 1} {
	set indent 5
    }
    if {$text == {\(bu}} {
	set text "\u00b7"
    }

    set tab [expr $indent * 0.1]i
    newPara $tab -$tab
    set state(sb) 80
    setTabs $tab
    formattedText $text
    tab
}







|







823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
    } elseif {$length == 1} {
	set indent 5
    }
    if {$text == {\(bu}} {
	set text "\u00b7"
    }

    set tab [expr {$indent * 0.1}]i
    newPara $tab -$tab
    set state(sb) 80
    setTabs $tab
    formattedText $text
    tab
}

Changes to tools/man2html2.tcl.

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
...
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
...
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
# string -		Text to output in the paragraph.

proc text string {
    global file textState inDT charCnt inTable

    set pos [string first "\t" $string]
    if {$pos >= 0} {
    	text [string range $string 0 [expr $pos-1]]
    	tab
    	text [string range $string [expr $pos+1] end]
	return
    }
    if {$inTable} {
	if {$inTable == 1} {
	    puts -nonewline $file <TR>
	    set inTable 2
	}
................................................................................
#	puts "formattedText: $text"
    while {$text ne ""} {
	set index [string first \\ $text]
	if {$index < 0} {
	    text $text
	    return
	}
	text [string range $text 0 [expr $index-1]]
	set c [string index $text [expr $index+1]]
	switch -- $c {
	    f {
		font [string index $text [expr $index+2]]
		set text [string range $text [expr $index+3] end]
	    }
	    e {
		text \\
		set text [string range $text [expr $index+2] end]
	    }
	    - {
		dash
		set text [string range $text [expr $index+2] end]
	    }
	    | {
		set text [string range $text [expr $index+2] end]
	    }
	    default {
		puts stderr "Unknown sequence: \\$c"
		set text [string range $text [expr $index+2] end]
	    }
	}
    }
}
 
##############################################################################
# dash --
................................................................................
# Arguments:
# None.

proc tab {} {
    global inPRE charCnt tabString file
#	? charCnt
    if {$inPRE == 1} {
	set pos [expr $charCnt % [string length $tabString] ]
	set spaces [string first "1" [string range $tabString $pos end] ]
	text [format "%*s" [incr spaces] " "]
    } else {
#	puts "tab: found tab outside of <PRE> block"
    }
}







|

|







 







|
|


|
|



|



|


|



|







 







|







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
...
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
...
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
# string -		Text to output in the paragraph.

proc text string {
    global file textState inDT charCnt inTable

    set pos [string first "\t" $string]
    if {$pos >= 0} {
    	text [string range $string 0 [expr {$pos-1}]]
    	tab
    	text [string range $string [expr {$pos+1}] end]
	return
    }
    if {$inTable} {
	if {$inTable == 1} {
	    puts -nonewline $file <TR>
	    set inTable 2
	}
................................................................................
#	puts "formattedText: $text"
    while {$text ne ""} {
	set index [string first \\ $text]
	if {$index < 0} {
	    text $text
	    return
	}
	text [string range $text 0 [expr {$index-1}]]
	set c [string index $text [expr {$index+1}]]
	switch -- $c {
	    f {
		font [string index $text [expr {$index+2}]]
		set text [string range $text [expr {$index+3}] end]
	    }
	    e {
		text \\
		set text [string range $text [expr {$index+2}] end]
	    }
	    - {
		dash
		set text [string range $text [expr {$index+2}] end]
	    }
	    | {
		set text [string range $text [expr {$index+2}] end]
	    }
	    default {
		puts stderr "Unknown sequence: \\$c"
		set text [string range $text [expr {$index+2}] end]
	    }
	}
    }
}
 
##############################################################################
# dash --
................................................................................
# Arguments:
# None.

proc tab {} {
    global inPRE charCnt tabString file
#	? charCnt
    if {$inPRE == 1} {
	set pos [expr {$charCnt % [string length $tabString]}]
	set spaces [string first "1" [string range $tabString $pos end] ]
	text [format "%*s" [incr spaces] " "]
    } else {
#	puts "tab: found tab outside of <PRE> block"
    }
}

Changes to tools/regexpTestLib.tcl.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
...
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    set fileId [open $inFileName r]

    set i 0
    while {[gets $fileId line] >= 0} {

	set len [string length $line]

	if {($len > 0) && ([string index $line [expr $len - 1]] == "\\")} {
	    if {[info exists lineArray(c$i)] == 0} {
		set lineArray(c$i) 1
	    } else {
		incr lineArray(c$i)
	    }
	    set line [string range $line 0 [expr $len - 2]]
	    append lineArray($i) $line
	    continue
	}
	if {[info exists lineArray(c$i)] == 0} {
	    set lineArray(c$i) 1
	} else {
	    incr lineArray(c$i)
................................................................................
	}
	set str [lindex $currentLine 2]
    }
    set flags [removeFlags $flags]

    # find the test result

    set numVars [expr $len - 3]
    set vars {}
    set vals {}
    set result 0
    set v 0

    if {[regsub {\*} "$flags" "" newFlags] == 1} {
	# an error is expected






|





|







 







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
...
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
    set fileId [open $inFileName r]

    set i 0
    while {[gets $fileId line] >= 0} {

	set len [string length $line]

	if {($len > 0) && ([string index $line [expr {$len - 1}]] == "\\")} {
	    if {[info exists lineArray(c$i)] == 0} {
		set lineArray(c$i) 1
	    } else {
		incr lineArray(c$i)
	    }
	    set line [string range $line 0 [expr {$len - 2}]]
	    append lineArray($i) $line
	    continue
	}
	if {[info exists lineArray(c$i)] == 0} {
	    set lineArray(c$i) 1
	} else {
	    incr lineArray(c$i)
................................................................................
	}
	set str [lindex $currentLine 2]
    }
    set flags [removeFlags $flags]

    # find the test result

    set numVars [expr {$len - 3}]
    set vars {}
    set vals {}
    set result 0
    set v 0

    if {[regsub {\*} "$flags" "" newFlags] == 1} {
	# an error is expected

Changes to tools/str2c.

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
} else {
    puts "/*
 * Multi parts read only string generated by str2c
 */
static const char * const data\[\]= {"
    set n 1
    for {set i 0} {$i<$lg} {incr i $MAX} {
	set part [string range $r $i [expr $i+$MAX-1]]
	set len  [string length $part];
	puts "\t/* Start of part $n ($len characters) */"
	puts "\t\"[translate $part]\","
	puts "\t/* End of part $n */\n"
	incr n
    }
    puts "\tNULL\t/* End of data marker */\n};"






|







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
} else {
    puts "/*
 * Multi parts read only string generated by str2c
 */
static const char * const data\[\]= {"
    set n 1
    for {set i 0} {$i<$lg} {incr i $MAX} {
	set part [string range $r $i [expr {$i+$MAX-1}]]
	set len  [string length $part];
	puts "\t/* Start of part $n ($len characters) */"
	puts "\t\"[translate $part]\","
	puts "\t/* End of part $n */\n"
	incr n
    }
    puts "\tNULL\t/* End of data marker */\n};"