Fossil SCM
Found easier way to access the typevariables of singletons when writing the rcs parser. Now moved the other singletons to the same construction.
Commit
70b0aa899a4885b1d0606691d6f58c32a9c0a453
Parent
84871722547960b…
4 files changed
+5
-4
+2
-1
+8
-3
+1
-1
| --- tools/cvs2fossil/lib/c2f_pass.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_pass.tcl | ||
| @@ -122,31 +122,32 @@ | ||
| 122 | 122 | |
| 123 | 123 | # # ## ### ##### ######## ############# |
| 124 | 124 | ## Internal methods |
| 125 | 125 | |
| 126 | 126 | proc Ok? {code label ov {emptyok 1}} { |
| 127 | - upvar 1 mydesc mydesc $ov ok | |
| 127 | + upvar 1 $ov ok | |
| 128 | + ::variable mydesc | |
| 128 | 129 | if {$emptyok && ($code eq "")} return |
| 129 | 130 | if {[info exists mydesc($code)]} return |
| 130 | 131 | if {$label ne ""} {append label " "} |
| 131 | 132 | trouble fatal "Bad ${label}pass code $code" |
| 132 | 133 | set ok 0 |
| 133 | 134 | return |
| 134 | 135 | } |
| 135 | 136 | |
| 136 | 137 | proc Convert {code default} { |
| 137 | - upvar 1 mypasses mypasses | |
| 138 | + ::variable mypasses | |
| 138 | 139 | return [expr {($code eq "") ? $default : [Id $code]}] |
| 139 | 140 | } |
| 140 | 141 | |
| 141 | 142 | proc Id {code} { |
| 142 | - upvar 1 mypasses mypasses | |
| 143 | + ::variable mypasses | |
| 143 | 144 | return [lsearch -exact $mypasses $code] |
| 144 | 145 | } |
| 145 | 146 | |
| 146 | 147 | proc Call {code args} { |
| 147 | - upvar 1 mycmd mycmd | |
| 148 | + ::variable mycmd | |
| 148 | 149 | set cmd $mycmd($code) |
| 149 | 150 | foreach a $args { lappend cmd $a } |
| 150 | 151 | eval $cmd |
| 151 | 152 | return |
| 152 | 153 | } |
| 153 | 154 |
| --- tools/cvs2fossil/lib/c2f_pass.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pass.tcl | |
| @@ -122,31 +122,32 @@ | |
| 122 | |
| 123 | # # ## ### ##### ######## ############# |
| 124 | ## Internal methods |
| 125 | |
| 126 | proc Ok? {code label ov {emptyok 1}} { |
| 127 | upvar 1 mydesc mydesc $ov ok |
| 128 | if {$emptyok && ($code eq "")} return |
| 129 | if {[info exists mydesc($code)]} return |
| 130 | if {$label ne ""} {append label " "} |
| 131 | trouble fatal "Bad ${label}pass code $code" |
| 132 | set ok 0 |
| 133 | return |
| 134 | } |
| 135 | |
| 136 | proc Convert {code default} { |
| 137 | upvar 1 mypasses mypasses |
| 138 | return [expr {($code eq "") ? $default : [Id $code]}] |
| 139 | } |
| 140 | |
| 141 | proc Id {code} { |
| 142 | upvar 1 mypasses mypasses |
| 143 | return [lsearch -exact $mypasses $code] |
| 144 | } |
| 145 | |
| 146 | proc Call {code args} { |
| 147 | upvar 1 mycmd mycmd |
| 148 | set cmd $mycmd($code) |
| 149 | foreach a $args { lappend cmd $a } |
| 150 | eval $cmd |
| 151 | return |
| 152 | } |
| 153 |
| --- tools/cvs2fossil/lib/c2f_pass.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pass.tcl | |
| @@ -122,31 +122,32 @@ | |
| 122 | |
| 123 | # # ## ### ##### ######## ############# |
| 124 | ## Internal methods |
| 125 | |
| 126 | proc Ok? {code label ov {emptyok 1}} { |
| 127 | upvar 1 $ov ok |
| 128 | ::variable mydesc |
| 129 | if {$emptyok && ($code eq "")} return |
| 130 | if {[info exists mydesc($code)]} return |
| 131 | if {$label ne ""} {append label " "} |
| 132 | trouble fatal "Bad ${label}pass code $code" |
| 133 | set ok 0 |
| 134 | return |
| 135 | } |
| 136 | |
| 137 | proc Convert {code default} { |
| 138 | ::variable mypasses |
| 139 | return [expr {($code eq "") ? $default : [Id $code]}] |
| 140 | } |
| 141 | |
| 142 | proc Id {code} { |
| 143 | ::variable mypasses |
| 144 | return [lsearch -exact $mypasses $code] |
| 145 | } |
| 146 | |
| 147 | proc Call {code args} { |
| 148 | ::variable mycmd |
| 149 | set cmd $mycmd($code) |
| 150 | foreach a $args { lappend cmd $a } |
| 151 | eval $cmd |
| 152 | return |
| 153 | } |
| 154 |
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | ||
| @@ -163,10 +163,12 @@ | ||
| 163 | 163 | |
| 164 | 164 | return $f |
| 165 | 165 | } |
| 166 | 166 | |
| 167 | 167 | proc IsSuperceded {base rcs usr isattic} { |
| 168 | + ::variable myignore | |
| 169 | + | |
| 168 | 170 | if {!$isattic} {return 0} |
| 169 | 171 | if {![file exists $base/$usr,v]} {return 0} |
| 170 | 172 | |
| 171 | 173 | # We have a regular archive and an Attic archive refering to |
| 172 | 174 | # the same user visible file. Ignore the file in the Attic. |
| @@ -174,11 +176,10 @@ | ||
| 174 | 176 | # By default this is a problem causing an abort after the pass |
| 175 | 177 | # has completed. The user can however force us to ignore it. |
| 176 | 178 | # In that case the warning is still printed, but will not |
| 177 | 179 | # induce an abort any longer. |
| 178 | 180 | |
| 179 | - upvar 1 myignore myignore | |
| 180 | 181 | if {$myignore} { |
| 181 | 182 | log write 2 collar "Ignored $rcs, superceded archive" |
| 182 | 183 | } else { |
| 183 | 184 | trouble warn "Ignored $rcs, superceded archive" |
| 184 | 185 | } |
| 185 | 186 |
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| @@ -163,10 +163,12 @@ | |
| 163 | |
| 164 | return $f |
| 165 | } |
| 166 | |
| 167 | proc IsSuperceded {base rcs usr isattic} { |
| 168 | if {!$isattic} {return 0} |
| 169 | if {![file exists $base/$usr,v]} {return 0} |
| 170 | |
| 171 | # We have a regular archive and an Attic archive refering to |
| 172 | # the same user visible file. Ignore the file in the Attic. |
| @@ -174,11 +176,10 @@ | |
| 174 | # By default this is a problem causing an abort after the pass |
| 175 | # has completed. The user can however force us to ignore it. |
| 176 | # In that case the warning is still printed, but will not |
| 177 | # induce an abort any longer. |
| 178 | |
| 179 | upvar 1 myignore myignore |
| 180 | if {$myignore} { |
| 181 | log write 2 collar "Ignored $rcs, superceded archive" |
| 182 | } else { |
| 183 | trouble warn "Ignored $rcs, superceded archive" |
| 184 | } |
| 185 |
| --- tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| +++ tools/cvs2fossil/lib/c2f_pcollar.tcl | |
| @@ -163,10 +163,12 @@ | |
| 163 | |
| 164 | return $f |
| 165 | } |
| 166 | |
| 167 | proc IsSuperceded {base rcs usr isattic} { |
| 168 | ::variable myignore |
| 169 | |
| 170 | if {!$isattic} {return 0} |
| 171 | if {![file exists $base/$usr,v]} {return 0} |
| 172 | |
| 173 | # We have a regular archive and an Attic archive refering to |
| 174 | # the same user visible file. Ignore the file in the Attic. |
| @@ -174,11 +176,10 @@ | |
| 176 | # By default this is a problem causing an abort after the pass |
| 177 | # has completed. The user can however force us to ignore it. |
| 178 | # In that case the warning is still printed, but will not |
| 179 | # induce an abort any longer. |
| 180 | |
| 181 | if {$myignore} { |
| 182 | log write 2 collar "Ignored $rcs, superceded archive" |
| 183 | } else { |
| 184 | trouble warn "Ignored $rcs, superceded archive" |
| 185 | } |
| 186 |
| --- tools/cvs2fossil/lib/c2f_repository.tcl | ||
| +++ tools/cvs2fossil/lib/c2f_repository.tcl | ||
| @@ -174,11 +174,12 @@ | ||
| 174 | 174 | proc .NFileLength {p} { |
| 175 | 175 | return [string length [llength [$p filenames]]] |
| 176 | 176 | } |
| 177 | 177 | |
| 178 | 178 | proc IsRepositoryBase {path mv} { |
| 179 | - upvar 1 $mv msg mybase mybase | |
| 179 | + ::variable mybase | |
| 180 | + upvar 1 $mv msg | |
| 180 | 181 | if {![fileutil::test $mybase edr msg {CVS Repository}]} {return 0} |
| 181 | 182 | if {![fileutil::test $mybase/CVSROOT edr msg {CVS Admin Directory}]} {return 0} |
| 182 | 183 | return 1 |
| 183 | 184 | } |
| 184 | 185 | |
| @@ -194,20 +195,24 @@ | ||
| 194 | 195 | } |
| 195 | 196 | return 1 |
| 196 | 197 | } |
| 197 | 198 | |
| 198 | 199 | proc TheProjects {} { |
| 199 | - upvar 1 myprojects myprojects myprojpaths myprojpaths mybase mybase type type | |
| 200 | + upvar 1 type type | |
| 201 | + ::variable myprojects | |
| 202 | + ::variable myprojpaths | |
| 203 | + ::variable mybase | |
| 200 | 204 | |
| 201 | 205 | if {![llength $myprojects]} { |
| 202 | 206 | set myprojects [EmptyProjects $myprojpaths] |
| 203 | 207 | } |
| 204 | 208 | return $myprojects |
| 205 | 209 | } |
| 206 | 210 | |
| 207 | 211 | proc EmptyProjects {projpaths} { |
| 208 | - upvar 1 mybase mybase type type | |
| 212 | + ::variable mybase | |
| 213 | + upvar 1 type type | |
| 209 | 214 | set res {} |
| 210 | 215 | if {[llength $projpaths]} { |
| 211 | 216 | foreach pp $projpaths { |
| 212 | 217 | lappend res [project %AUTO% $pp $type] |
| 213 | 218 | } |
| 214 | 219 |
| --- tools/cvs2fossil/lib/c2f_repository.tcl | |
| +++ tools/cvs2fossil/lib/c2f_repository.tcl | |
| @@ -174,11 +174,12 @@ | |
| 174 | proc .NFileLength {p} { |
| 175 | return [string length [llength [$p filenames]]] |
| 176 | } |
| 177 | |
| 178 | proc IsRepositoryBase {path mv} { |
| 179 | upvar 1 $mv msg mybase mybase |
| 180 | if {![fileutil::test $mybase edr msg {CVS Repository}]} {return 0} |
| 181 | if {![fileutil::test $mybase/CVSROOT edr msg {CVS Admin Directory}]} {return 0} |
| 182 | return 1 |
| 183 | } |
| 184 | |
| @@ -194,20 +195,24 @@ | |
| 194 | } |
| 195 | return 1 |
| 196 | } |
| 197 | |
| 198 | proc TheProjects {} { |
| 199 | upvar 1 myprojects myprojects myprojpaths myprojpaths mybase mybase type type |
| 200 | |
| 201 | if {![llength $myprojects]} { |
| 202 | set myprojects [EmptyProjects $myprojpaths] |
| 203 | } |
| 204 | return $myprojects |
| 205 | } |
| 206 | |
| 207 | proc EmptyProjects {projpaths} { |
| 208 | upvar 1 mybase mybase type type |
| 209 | set res {} |
| 210 | if {[llength $projpaths]} { |
| 211 | foreach pp $projpaths { |
| 212 | lappend res [project %AUTO% $pp $type] |
| 213 | } |
| 214 |
| --- tools/cvs2fossil/lib/c2f_repository.tcl | |
| +++ tools/cvs2fossil/lib/c2f_repository.tcl | |
| @@ -174,11 +174,12 @@ | |
| 174 | proc .NFileLength {p} { |
| 175 | return [string length [llength [$p filenames]]] |
| 176 | } |
| 177 | |
| 178 | proc IsRepositoryBase {path mv} { |
| 179 | ::variable mybase |
| 180 | upvar 1 $mv msg |
| 181 | if {![fileutil::test $mybase edr msg {CVS Repository}]} {return 0} |
| 182 | if {![fileutil::test $mybase/CVSROOT edr msg {CVS Admin Directory}]} {return 0} |
| 183 | return 1 |
| 184 | } |
| 185 | |
| @@ -194,20 +195,24 @@ | |
| 195 | } |
| 196 | return 1 |
| 197 | } |
| 198 | |
| 199 | proc TheProjects {} { |
| 200 | upvar 1 type type |
| 201 | ::variable myprojects |
| 202 | ::variable myprojpaths |
| 203 | ::variable mybase |
| 204 | |
| 205 | if {![llength $myprojects]} { |
| 206 | set myprojects [EmptyProjects $myprojpaths] |
| 207 | } |
| 208 | return $myprojects |
| 209 | } |
| 210 | |
| 211 | proc EmptyProjects {projpaths} { |
| 212 | ::variable mybase |
| 213 | upvar 1 type type |
| 214 | set res {} |
| 215 | if {[llength $projpaths]} { |
| 216 | foreach pp $projpaths { |
| 217 | lappend res [project %AUTO% $pp $type] |
| 218 | } |
| 219 |
+1
-1
| --- tools/cvs2fossil/lib/log.tcl | ||
| +++ tools/cvs2fossil/lib/log.tcl | ||
| @@ -107,11 +107,11 @@ | ||
| 107 | 107 | |
| 108 | 108 | # # ## ### ##### ######## ############# |
| 109 | 109 | ## Internal, helper methods (formatting, dispatch) |
| 110 | 110 | |
| 111 | 111 | proc System {s} { |
| 112 | - upvar 1 mysysfmt mysysfmt | |
| 112 | + ::variable mysysfmt | |
| 113 | 113 | return [format $mysysfmt $s] |
| 114 | 114 | } |
| 115 | 115 | |
| 116 | 116 | # # ## ### ##### ######## ############# |
| 117 | 117 | ## Standard output callback, module internal |
| 118 | 118 |
| --- tools/cvs2fossil/lib/log.tcl | |
| +++ tools/cvs2fossil/lib/log.tcl | |
| @@ -107,11 +107,11 @@ | |
| 107 | |
| 108 | # # ## ### ##### ######## ############# |
| 109 | ## Internal, helper methods (formatting, dispatch) |
| 110 | |
| 111 | proc System {s} { |
| 112 | upvar 1 mysysfmt mysysfmt |
| 113 | return [format $mysysfmt $s] |
| 114 | } |
| 115 | |
| 116 | # # ## ### ##### ######## ############# |
| 117 | ## Standard output callback, module internal |
| 118 |
| --- tools/cvs2fossil/lib/log.tcl | |
| +++ tools/cvs2fossil/lib/log.tcl | |
| @@ -107,11 +107,11 @@ | |
| 107 | |
| 108 | # # ## ### ##### ######## ############# |
| 109 | ## Internal, helper methods (formatting, dispatch) |
| 110 | |
| 111 | proc System {s} { |
| 112 | ::variable mysysfmt |
| 113 | return [format $mysysfmt $s] |
| 114 | } |
| 115 | |
| 116 | # # ## ### ##### ######## ############# |
| 117 | ## Standard output callback, module internal |
| 118 |