Check-in [b811cbd1a6]
Not logged in

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

Overview
Comment:add selected tcllib upstream changes
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b811cbd1a62687ad4f722439a7d00df93429893a
User & Date: chw 2019-07-02 04:40:44
Context
2019-07-04
04:36
add patch from ticket [d7c10bb26f] check-in: 907e1f9b6e user: chw tags: trunk
2019-07-02
04:40
add selected tcllib upstream changes check-in: b811cbd1a6 user: chw tags: trunk
04:06
add tcl upstream changes check-in: 3567d254c3 user: chw tags: trunk
Changes

assets/tcllib1.19/math/pdf_stat.tcl became a regular file.

assets/tcllib1.19/simulation/pkgIndex.tcl became a regular file.

assets/tcllib1.19/simulation/random.tcl became a regular file.

Added assets/tcllib1.19/textutil/patch.tcl.









































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
# patch.tcl --
#
#	Application of a diff -ruN patch to a directory tree.
#
# Copyright (c) 2019 Christian Gollwitzer <auriocus@gmx.de>
# with tweaks by Andreas Kupries
# - Factored patch parsing into a helper
# - Replaced `puts` with report callback.

package require Tcl 8.5
package provide textutil::patch 0.1

# # ## ### ##### ######## ############# #####################

namespace eval ::textutil::patch {
    namespace export apply
    namespace ensemble create
}

# # ## ### ##### ######## ############# #####################

proc ::textutil::patch::apply {dir striplevel patch reportcmd} {
    set patchdict [Parse $dir $striplevel $patch]

    # Apply, now that we have parsed the patch.
    dict for {fn hunks} $patchdict {
	Report apply $fn
	if {[catch {open $fn} fd]} {
	    set orig {}
	} else {
	    set orig [split [read $fd] \n]
	}
	close $fd

	set patched $orig

	set fail false
	set already_applied false
	set hunknr 1
	foreach hunk $hunks {
	    dict with hunk {
		set oldend [expr {$oldstart+[llength $oldcode]-1}]
		set newend [expr {$newstart+[llength $newcode]-1}]
		# check if the hunk matches
		set origcode [lrange $orig $oldstart $oldend]
		if {$origcode ne $oldcode} {
		    set fail true
		    # check if the patch is already applied
		    set origcode_applied [lrange $orig $newstart $newend]
		    if {$origcode_applied eq $newcode} {
			set already_applied true
			Report fail-already $fn $hunknr
		    } else {
			Report fail $fn $hunknr $oldcode $origcode
		    }
		    break
		}
		# apply patch
		set patched [list \
				 {*}[lrange $patched 0 $newstart-1] \
				 {*}$newcode \
				 {*}[lrange $orig $oldend+1 end]]
	    }
	    incr hunknr
	}

	if {!$fail} {
	    # success - write the result back
	    set fd [open $fn w]
	    puts -nonewline $fd [join $patched \n]
	    close $fd
	}
    }

    return
}

# # ## ### ##### ######## ############# #####################

proc ::textutil::patch::Report {args} {
    upvar 1 reportcmd reportcmd
    uplevel #0 [list {*}$reportcmd {*}$args]
    ##
    # apply        $fname
    # fail-already $fname $hunkno
    # fail         $fname $hunkno $expected $seen
    ##
}

proc ::textutil::patch::Parse {dir striplevel patch} {
    set patchlines [split $patch \n]
    set inhunk false
    set oldcode {}
    set newcode {}
    set n [llength $patchlines]

    set patchdict {}
    for {set lineidx 0} {$lineidx < $n} {incr lineidx} {
	set line [lindex $patchlines $lineidx]
	if {[string match ---* $line]} {
	    # a diff block starts. Current line should be
	    # --- oldfile date time TZ
	    # Next line should be
	    # +++ newfile date time TZ
	    set in $line
	    incr lineidx
	    set out [lindex $patchlines $lineidx]

	    if {![string match ---* $in] || ![string match +++* $out]} {
		#puts $in
		#puts $out
		return -code error "Patch not in unified diff format, line $lineidx $in $out"
	    }

	    # the quoting is compatible with list
	    lassign $in  -> oldfile
	    lassign $out -> newfile

	    set fntopatch [file join $dir {*}[lrange [file split $oldfile] $striplevel end]]
	    set inhunk false
	    #puts "Found diffline for $fntopatch"
	    continue
	}

	# state machine for parsing the hunks
	set typechar [string index $line 0]
	set codeline [string range $line 1 end]
	switch $typechar {
	    @ {
		if {![regexp {@@\s+\-(\d+),(\d+)\s+\+(\d+),(\d+)\s+@@} $line \
			  -> oldstart oldlen newstart newlen]} {
		    return code -error "Erroneous hunk in line $lindeidx, $line"
		}
		# adjust line numbers for 0-based indexing
		incr oldstart -1
		incr newstart -1
		#puts "New hunk"
		set newcode {}
		set oldcode {}
		set inhunk true
	    }
	    - { # line only in old code
		if {$inhunk} {
		    lappend oldcode $codeline
		}
	    }
	    + { # line only in new code
		if {$inhunk} {
		    lappend newcode $codeline
		}
	    }
	    " " { # common line
		if {$inhunk} {
		    lappend oldcode $codeline
		    lappend newcode $codeline
		}
	    }
	    default {
		# puts "Junk: $codeline";
		continue
	    }
	}
	# test if the hunk is complete
	if {[llength $oldcode]==$oldlen && [llength $newcode]==$newlen} {
	    set hunk [dict create \
			  oldcode $oldcode \
			  newcode $newcode \
			  oldstart $oldstart \
			  newstart $newstart]
	    #puts "hunk complete: $hunk"
	    set inhunk false
	    dict lappend patchdict $fntopatch $hunk
	}
    }

    return $patchdict
}

# # ## ### ##### ######## ############# #####################
return

Changes to assets/tcllib1.19/textutil/pkgIndex.tcl.

6
7
8
9
10
11
12
13




package ifneeded textutil::adjust   0.7.3 [list source [file join $dir adjust.tcl]]
package ifneeded textutil::split    0.8   [list source [file join $dir split.tcl]]
package ifneeded textutil::trim     0.7   [list source [file join $dir trim.tcl]]
package ifneeded textutil::tabify   0.7   [list source [file join $dir tabify.tcl]]
package ifneeded textutil::repeat   0.7   [list source [file join $dir repeat.tcl]]
package ifneeded textutil::string   0.8   [list source [file join $dir string.tcl]]
package ifneeded textutil::expander 1.3.1 [list source [file join $dir expander.tcl]]
package ifneeded textutil::wcswidth 35.0  [list source [file join $dir wcswidth.tcl]]











|
>
>
>
>
6
7
8
9
10
11
12
13
14
15
16
17
package ifneeded textutil::adjust   0.7.3 [list source [file join $dir adjust.tcl]]
package ifneeded textutil::split    0.8   [list source [file join $dir split.tcl]]
package ifneeded textutil::trim     0.7   [list source [file join $dir trim.tcl]]
package ifneeded textutil::tabify   0.7   [list source [file join $dir tabify.tcl]]
package ifneeded textutil::repeat   0.7   [list source [file join $dir repeat.tcl]]
package ifneeded textutil::string   0.8   [list source [file join $dir string.tcl]]
package ifneeded textutil::expander 1.3.1 [list source [file join $dir expander.tcl]]
package ifneeded textutil::wcswidth 35.1  [list source [file join $dir wcswidth.tcl]]

if {![package vsatisfies [package provide Tcl] 8.5]} { return }

package ifneeded textutil::patch 0.1 [list source [file join $dir patch.tcl]]

Changes to assets/tcllib1.19/textutil/wcswidth.tcl.

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
# based on information in the following database:
# http://www.unicode.org/Public/UCD/latest/ucd/EastAsianWidth.txt
#
# (This is the 35th edition, thus version 35 for our package)
#
# Author: Sean Woods <yoda@etoyoc.com>
###
package provide textutil::wcswidth 35.0
proc ::textutil::wcswidth_type char {
  if {$char == 161} { return A }
  if {$char == 164} { return A }
  if {$char == 167} { return A }
  if {$char == 168} { return A }
  if {$char == 170} { return A }
  if {$char == 173} { return A }
................................................................................
  if {$char >= 196608 && $char <= 262141 } { return 2 }
  return 1
}

proc ::textutil::wcswidth {string} {
  set width 0
  set len [string length $string]
  for {set i 0} {$i < $len} {incr i} {
    scan [string index $string $i] %c char
    set n [::textutil::wcswidth_char $char]
    if {$n < 0} {
      return -1
    }
    incr width $n
  }
  return $width
}








|







 







|
|









3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
# based on information in the following database:
# http://www.unicode.org/Public/UCD/latest/ucd/EastAsianWidth.txt
#
# (This is the 35th edition, thus version 35 for our package)
#
# Author: Sean Woods <yoda@etoyoc.com>
###
package provide textutil::wcswidth 35.1
proc ::textutil::wcswidth_type char {
  if {$char == 161} { return A }
  if {$char == 164} { return A }
  if {$char == 167} { return A }
  if {$char == 168} { return A }
  if {$char == 170} { return A }
  if {$char == 173} { return A }
................................................................................
  if {$char >= 196608 && $char <= 262141 } { return 2 }
  return 1
}

proc ::textutil::wcswidth {string} {
  set width 0
  set len [string length $string]
  foreach c [split $string {}] {
    scan $c %c char
    set n [::textutil::wcswidth_char $char]
    if {$n < 0} {
      return -1
    }
    incr width $n
  }
  return $width
}