d1a67b9d |
1 | # This script provides commands for upgrade of OCCT and software based on it |
2 | # to a newer version of OCCT (7.0) |
3 | |
4 | |
5 | # source code for upgrading |
6 | set ArgName(HelpInfo) "h" |
7 | |
8 | set ArgName(SourceCode) "src" |
9 | set ArgName(IncPath) "inc" |
10 | |
11 | set ArgName(IncExtension) "incext" |
12 | set ArgName(SrcExtension) "srcext" |
13 | |
14 | set ArgName(RTTI) "rtti" |
15 | |
16 | set ArgName(CStyleCastHandle) "handlecast" |
17 | set ArgName(All) "all" |
18 | |
19 | set ArgName(Handle) "handle" |
20 | set ArgName(TCollection) "tcollection" |
21 | |
22 | set ArgName(CompatibleMode) "compat" |
23 | |
24 | set ArgName(Recurse) "recurse" |
25 | set ArgName(Rename) "rename" |
26 | |
27 | set ArgName(CheckOnly) "check" |
28 | set ArgName(WLog) "wlog" |
29 | set ArgName(Log) "log" |
30 | |
31 | proc HelpInformation {} { |
32 | global ArgName |
33 | global DataSectionName |
34 | |
35 | loginfo "Tool for upgrade of application code from older versions of OCCT." |
36 | loginfo "" |
37 | loginfo "Required parameter:" |
38 | loginfo " -$ArgName(SourceCode)=<path> - path to sources to upgrade" |
39 | loginfo "" |
40 | loginfo "File search options:" |
41 | loginfo " -$ArgName(IncPath)=<path> - path to header files of OCCT or other used libraries" |
42 | loginfo " -$ArgName(Recurse) - process all subfolders of '-$ArgName(SourceCode)' and '-$ArgName(IncPath)'" |
43 | loginfo " -$ArgName(SrcExtension)=cxx,cpp - extensions of source files" |
44 | loginfo " -$ArgName(IncExtension)=hxx,h,lxx,gxx - extensions of header files" |
45 | loginfo "" |
46 | loginfo "Upgrade options:" |
47 | loginfo " -$ArgName(All) - do all upgrades (if neither of below options are given)" |
48 | loginfo " -$ArgName(RTTI) - adapt code for changes in type system (RTTI) in OCCT 7.0" |
49 | loginfo " -$ArgName(Handle) - adapt code for changes in OCCT Handle" |
50 | loginfo " -$ArgName(TCollection) - replace forward declaration of TCollection classes by #include" |
51 | loginfo " -$ArgName(CStyleCastHandle) - replace c-style casts of Handle by DownCast()" |
52 | loginfo " -$ArgName(Rename) - apply renaming of classes" |
53 | loginfo "" |
54 | loginfo "Advanced options:" |
55 | loginfo " -$ArgName(CompatibleMode) - preserve old RTTI macros for compatability with OCCT 6.x" |
56 | loginfo " -$ArgName(CheckOnly) - do check only, no modifications will be made" |
57 | loginfo " -$ArgName(WLog) - show gui log of upgrade process" |
58 | loginfo " -$ArgName(Log)=<file path> - put the log into a file" |
59 | |
60 | return |
61 | } |
62 | |
63 | proc ParseArgs {theArgValues theArgs {theRemoveFromArgs "false"}} { |
64 | upvar $theArgValues anArgValues |
65 | |
66 | global ArgName |
67 | global DataSectionName |
68 | |
69 | # help information |
70 | set anArgValues(HelpInfo) [SeekArg $ArgName(HelpInfo) theArgs "false" $theRemoveFromArgs] |
71 | |
72 | # sources that will be upgraded |
73 | set anArgValues(SourceCode) [SeekArg $ArgName(SourceCode) theArgs "" $theRemoveFromArgs] |
74 | |
75 | set anArgValues(IncExtension) [SeekArg $ArgName(IncExtension) theArgs "h,hpp,hxx,gxx,lxx" $theRemoveFromArgs] |
76 | set anArgValues(SrcExtension) [SeekArg $ArgName(SrcExtension) theArgs "c,cpp,cxx" $theRemoveFromArgs] |
77 | |
78 | # inc folder |
79 | set anArgValues(IncPath) [SeekArg $ArgName(IncPath) theArgs "$anArgValues(SourceCode)" $theRemoveFromArgs] |
80 | |
81 | set anArgValues(RTTI) [SeekArg $ArgName(RTTI) theArgs "false" $theRemoveFromArgs] |
82 | set anArgValues(CStyleCastHandle) [SeekArg $ArgName(CStyleCastHandle) theArgs "false" $theRemoveFromArgs] |
83 | |
84 | set anArgValues(Handle) [SeekArg $ArgName(Handle) theArgs "false" $theRemoveFromArgs] |
85 | set anArgValues(TCollection) [SeekArg $ArgName(TCollection) theArgs "false" $theRemoveFromArgs] |
86 | |
87 | set anArgValues(Rename) [SeekArg $ArgName(Rename) theArgs "false" $theRemoveFromArgs] |
88 | |
89 | set aHasAgentArgs [expr {$anArgValues(RTTI) || $anArgValues(CStyleCastHandle) || \ |
90 | $anArgValues(Handle) || $anArgValues(TCollection)} || \ |
91 | $anArgValues(Rename)] |
92 | |
93 | set anArgValues(All) [SeekArg $ArgName(All) theArgs [expr {!$aHasAgentArgs}] $theRemoveFromArgs] |
94 | |
95 | set anArgValues(Recurse) [SeekArg $ArgName(Recurse) theArgs "false" $theRemoveFromArgs] |
96 | set anArgValues(CompatibleMode) [SeekArg $ArgName(CompatibleMode) theArgs "false" $theRemoveFromArgs] |
97 | set anArgValues(CheckOnly) [SeekArg $ArgName(CheckOnly) theArgs "false" $theRemoveFromArgs] |
98 | set anArgValues(WLog) [SeekArg $ArgName(WLog) theArgs "false" $theRemoveFromArgs] |
99 | |
100 | set anArgValues(Log) [SeekArg $ArgName(Log) theArgs "" $theRemoveFromArgs] |
101 | |
102 | return $theArgs |
103 | } |
104 | |
105 | proc SeekArg {theSoughtArgName theArgs {theDefaultArgValue ""} {theRemoveFromArgs false}} { |
106 | upvar ${theArgs} anArgs |
107 | |
108 | set aBooleanValue [string is boolean -strict $theDefaultArgValue] |
109 | |
110 | set anArgValues {} |
111 | |
112 | set anArgsIndex -1 |
113 | foreach anArg $anArgs { |
114 | incr anArgsIndex |
115 | |
116 | if {[regexp -- "-${theSoughtArgName}\=\(.\*\)" $anArg dummy anArgValue]} { |
117 | set anArgValue [regsub -all {\\} $anArgValue {/}] |
118 | if {$theRemoveFromArgs} { |
119 | set anArgs [lreplace $anArgs $anArgsIndex $anArgsIndex] |
120 | incr anArgsIndex -1 |
121 | } |
122 | if {"$anArgValue" != ""} { |
123 | lappend anArgValues $anArgValue |
124 | } else { |
125 | logwarn "'-${theSoughtArgName}' is skipped because it has empty value" |
126 | } |
127 | } elseif [string match "-${theSoughtArgName}" $anArg] { |
128 | if {$theRemoveFromArgs} { |
129 | set anArgs [lreplace $anArgs $anArgsIndex $anArgsIndex] |
130 | } |
131 | # skip non-boolean empty argument; do not break the foreach loop |
132 | if {$aBooleanValue} { |
133 | lappend anArgValues "true" |
134 | break |
135 | } else { |
136 | logwarn "'-${theSoughtArgName}' is skipped because it has empty value" |
137 | } |
138 | } |
139 | } |
140 | |
141 | # return boolean value as string |
142 | if {$aBooleanValue} { |
143 | if {[llength $anArgValues] > 0} { |
144 | return [lindex $anArgValues 0] |
145 | } else { |
146 | return $theDefaultArgValue |
147 | } |
148 | } |
149 | |
150 | if {[llength $anArgValues] == 0 && "$theDefaultArgValue" != ""} { |
151 | lappend anArgValues $theDefaultArgValue |
152 | } |
153 | |
154 | return $anArgValues |
155 | } |
156 | |
157 | # section names in the data file |
158 | set DataSectionName(TCollection) "tcollection" |
159 | set DataSectionName(Rename) "rename" |
160 | |
161 | proc DataFileName {} { |
162 | return [file join [file dirname [info script]] upgrade.dat] |
163 | } |
164 | |
165 | proc IsDataFileExist {} { |
166 | return [file exists [DataFileName]] |
167 | } |
168 | |
169 | proc ReadFromDataFile {theSectionName} { |
170 | if {![file exists [DataFileName]]} { |
171 | return |
172 | } |
173 | |
174 | set aFileContent [ReadFileToList [DataFileName] aFileRawContent aDataEOL] |
175 | |
176 | set aSectionValueList {} |
177 | |
178 | set anIsSection false |
179 | set aSectionPattern {^ *\[ *([A-Za-z0-9_\.]*) *\]+} |
180 | foreach aLine $aFileContent { |
181 | if {[regexp -- $aSectionPattern $aLine dummy aSectionName]} { |
182 | if {"$aSectionName" == "$theSectionName"} { |
183 | set anIsSection true |
184 | continue |
185 | } elseif {$anIsSection == true} { |
186 | set anIsSection false |
187 | break |
188 | } |
189 | } |
190 | |
191 | if {$anIsSection == true} { |
192 | set aTrimmedLine [string trimright $aLine] |
193 | if {"$aTrimmedLine" != ""} { |
194 | lappend aSectionValueList $aTrimmedLine |
195 | } |
196 | } |
197 | } |
198 | |
199 | return $aSectionValueList |
200 | } |
201 | |
202 | proc SaveToDataFile {theSectionName theSectionContent} { |
203 | if {![file exists [DataFileName]]} { |
204 | return |
205 | } |
206 | |
207 | set aFileContent [ReadFileToList [DataFileName] aFileRawContent aDataEOL] |
208 | |
209 | set aLinesBefore {} |
210 | set aLinesAfter {} |
211 | |
212 | set anIsSection false |
213 | set anIsSectionBefore true |
214 | set anIsSectionAfter false |
215 | |
216 | set aSectionPattern {^ *\[ *([A-Za-z0-9_\.]*) *\]+} |
217 | foreach aLine $aFileContent { |
218 | if {$anIsSectionBefore} { |
219 | lappend aLinesBefore $aLine |
220 | } |
221 | |
222 | if {[regexp -- $aSectionPattern $aLine dummy aSectionName]} { |
223 | if {"$aSectionName" == "$theSectionName"} { |
224 | set anIsSectionBefore false |
225 | set anIsSection true |
226 | } elseif {$anIsSection == true} { |
227 | set anIsSection false |
228 | set anIsSectionAfter true |
229 | } |
230 | } |
231 | |
232 | if {$anIsSection == true} { |
233 | continue |
234 | } |
235 | |
236 | if {$anIsSectionAfter} { |
237 | lappend aLinesAfter $aLine |
238 | } |
239 | } |
240 | |
241 | # write to file |
242 | SaveListToFile [DataFileName] [list {*}$aLinesBefore {*}$theSectionContent {*}$aLinesAfter] $aDataEOL |
243 | } |
244 | |
245 | # Main tool, accepts path to location of source tree to be upgraded. |
246 | proc upgrade {args} { |
247 | |
248 | global ArgName |
249 | global LogFilePath |
250 | global DataSectionName |
251 | |
252 | set theArgs $args |
253 | set anUnparsedArgs [ParseArgs anArgValues $theArgs "true"] |
254 | |
255 | if {"$anUnparsedArgs" != ""} { |
256 | logerr "undefined arguments: $anUnparsedArgs" |
257 | loginfo "use -$ArgName(HelpInfo) to show all the arguments" |
258 | return |
259 | } |
260 | |
261 | if {$anArgValues(HelpInfo) || [llength $anArgValues(SourceCode)] == 0} { |
262 | HelpInformation |
263 | return |
264 | } |
265 | |
266 | if {"$anArgValues(Log)" != ""} { |
267 | set LogFilePath $anArgValues(Log) |
268 | |
269 | # clean file before writing |
270 | if {[file exists "$LogFilePath"]} { |
271 | set fd [open "$LogFilePath" r+] |
272 | chan truncate $fd 0 |
273 | close $fd |
274 | } |
275 | } |
276 | |
277 | if {$anArgValues(WLog)} { |
278 | _create_logger |
279 | } |
280 | |
281 | # collect src directory structure (all subdirs) |
282 | set anIncPaths {} |
283 | foreach aSrcDir $anArgValues(SourceCode) { |
284 | lappend anIncPaths $aSrcDir |
285 | foreach aSubSrcDir [CollectDirStructure $aSrcDir] { |
286 | lappend anIncPaths $aSubSrcDir |
287 | } |
288 | } |
289 | |
290 | foreach anIncDir $anArgValues(IncPath) { |
291 | lappend anIncPaths $anIncDir |
292 | foreach aSubIncDir [CollectDirStructure $anIncDir] { |
293 | lappend anIncPaths $aSubIncDir |
294 | } |
295 | } |
296 | |
297 | set anIncPaths [lsort -unique -dictionary $anIncPaths] |
298 | # end the collect |
299 | |
300 | set aRawNewNames [ReadFromDataFile $DataSectionName(Rename)] |
301 | foreach aRawName $aRawNewNames { |
302 | set aRawName [split $aRawName " "] |
303 | if {[llength $aRawName] > 1} { |
304 | # set aNewNames (old name) [new name] |
305 | set aNewNames([lindex ${aRawName} 0]) [lindex ${aRawName} 1] |
306 | } |
307 | } |
308 | |
309 | set aDoRename true |
310 | if {[llength [array names aNewNames]] == 0} { |
311 | set aDoRename false |
312 | |
313 | logwarn "renaming skipped. there is no class names to rename" |
314 | logwarn "see the content of [DataFileName] file, $DataSectionName(Rename) section" |
315 | } |
316 | |
317 | set aProcNameWithArgs "[lindex [info level 0] 0]" |
318 | foreach anArgName [array names anArgValues] { |
319 | if [string is boolean -strict $anArgValues($anArgName)] { |
320 | if [string is true "$anArgValues($anArgName)"] { |
321 | set aProcNameWithArgs [format "$aProcNameWithArgs -%s" "$ArgName($anArgName)"] |
322 | } |
323 | } else { |
324 | set aProcNameWithArgs [format "$aProcNameWithArgs -%s" "$ArgName($anArgName)=$anArgValues($anArgName)"] |
325 | } |
326 | } |
327 | |
328 | loginfo "$aProcNameWithArgs" |
329 | |
330 | # merge all processed extensions |
331 | set anExtensions "$anArgValues(SrcExtension),$anArgValues(IncExtension)" |
332 | |
333 | set aSourceCodePaths $anArgValues(SourceCode) |
334 | while {[llength $aSourceCodePaths]} { |
335 | set aSourceCodePaths [lassign $aSourceCodePaths aProcessedPath] |
336 | |
337 | loginfo "Processing: $aProcessedPath" |
338 | |
339 | if {$anArgValues(All) || $anArgValues(RTTI)} { |
340 | ConvertRtti $aProcessedPath \ |
341 | $anIncPaths \ |
342 | $anArgValues(CheckOnly) \ |
343 | $anArgValues(CompatibleMode) \ |
344 | $anArgValues(IncExtension) \ |
345 | $anArgValues(SrcExtension) |
346 | } |
347 | |
348 | if {$anArgValues(All) || $anArgValues(Handle)} { |
349 | ConvertHandle $aProcessedPath $anIncPaths $anArgValues(CheckOnly) $anExtensions |
350 | } |
351 | |
352 | if {$anArgValues(All) || $anArgValues(TCollection)} { |
353 | ConvertTColFwd $aProcessedPath $anArgValues(IncExtension) |
354 | } |
355 | |
356 | if {$anArgValues(All) || $anArgValues(CStyleCastHandle)} { |
357 | ConvertCStyleHandleCast $aProcessedPath $anExtensions $anArgValues(CheckOnly) |
358 | } |
359 | |
360 | if {$anArgValues(All) || $anArgValues(Rename)} { |
361 | if {$aDoRename} { |
362 | Rename $aProcessedPath $anExtensions aNewNames $anArgValues(CheckOnly) |
363 | } |
364 | } |
365 | |
366 | # Recurse processing |
367 | if {$anArgValues(Recurse)} { |
368 | lappend aSourceCodePaths {*}[glob -nocomplain -directory $aProcessedPath -type d *] |
369 | } |
370 | } |
371 | } |
372 | |
373 | # search and rename the indeces (old names) of @theNewNames with their values (new ones) |
374 | # processes files that have @theExtensions only in @thePath folder |
375 | proc Rename {thePath theExtensions theNewNames theCheckMode} { |
376 | upvar $theNewNames aNewNames |
377 | |
378 | set aNames [array names aNewNames] |
379 | |
380 | foreach aFile [glob -nocomplain -type f -directory $thePath *.{$theExtensions}] { |
381 | # loginfo "$aFile processing" |
382 | set aFileContent [ReadFileToRawText $aFile] |
383 | |
384 | set aHasChanges false |
385 | foreach aName $aNames { |
386 | set anIndexInRow 0 |
387 | set aClassNameTmpl "\\m$aName\\M" |
388 | while { [regexp -start $anIndexInRow -indices -lineanchor $aClassNameTmpl $aFileContent aFoundClassNameLoc] } { |
389 | set anIndexInRow [lindex $aFoundClassNameLoc 1] |
390 | |
391 | if {$theCheckMode} { |
392 | logwarn "Warning: $aFile contains $aName" |
393 | break |
394 | } else { |
395 | set aHasChanges true |
396 | ReplaceSubString aFileContent $aFoundClassNameLoc "$aNewNames($aName)" anIndexInRow |
397 | incr anIndexInRow -1 |
398 | } |
399 | } |
400 | } |
401 | |
402 | if {$aHasChanges} { |
403 | SaveTextToFile $aFile $aFileContent |
404 | } |
405 | } |
406 | } |
407 | |
408 | # @thePackagePath eather file or folder. If it is a folder, |
409 | # all files with @theHeaderExtensions are processed. |
410 | # "fwd.tcollection" section from upgrade.ini file is used to find out what |
411 | # classes have been converted and, thus, what forward declarations can be replaced |
412 | proc ConvertTColFwd {thePackagePath theHeaderExtensions} { |
413 | global DataSectionName |
414 | |
415 | # Note: the content of theHeaderExtensions should have |
416 | # further form (values separated by comma): "ext1,ext2,ext3" |
417 | # this form will be used below in reg expression to collect all header files |
418 | |
419 | if {! [file exists $thePackagePath]} { |
420 | logerr "Error: $thePackagePath does not exist" |
421 | return |
422 | } |
423 | |
424 | # read the list of already converted TCollection classes |
425 | if [IsDataFileExist] { |
426 | set aConvertedTColClasses [ReadFromDataFile $DataSectionName(TCollection)] |
427 | } else { |
428 | logerr "[DataFileName] file of upgrade process does not exist" |
429 | return |
430 | } |
431 | |
432 | # pattern that will be used |
433 | set aForwardDeclPattern {^ *class *([A-Za-z0-9_/\.]+) *;} |
434 | |
435 | set aTargetPaths ${thePackagePath} |
436 | while {[llength $aTargetPaths]} { |
437 | set aTargetPaths [lassign $aTargetPaths aProcessedPath] |
438 | |
439 | # if aProcessedPath is a folder, collect all files with $theHeaderExtensions from it |
440 | set aProcessedHeaders ${aProcessedPath} |
441 | if {[file isdirectory $aProcessedPath]} { |
442 | # get all header files |
443 | set aProcessedHeaders [glob -nocomplain -type f -directory $aProcessedPath *.{$theHeaderExtensions}] |
444 | } |
445 | |
446 | foreach aHeader $aProcessedHeaders { |
447 | set aHeaderLineIndex -1 |
448 | set aHeaderContentUpdated false |
449 | |
450 | # read the content of the header file |
451 | set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL] |
452 | |
453 | # remove _isMulti variable that used in _check_line |
454 | set _isMulti false |
455 | |
456 | foreach aHeaderContentLine $aHeaderContent { |
457 | incr aHeaderLineIndex |
458 | |
459 | # remove _cmnt variable that used in _check_line |
460 | set _cmnt "" |
461 | |
462 | set aHeaderContentLine [_check_line $aHeaderContentLine] |
463 | if {[regexp {^ *class *([A-Za-z0-9_/\.]+) *;} $aHeaderContentLine dummy aForwardDeclClass]} { |
464 | if {[lsearch $aConvertedTColClasses $aForwardDeclClass] != -1} { |
465 | set aHeaderContentUpdated true |
466 | set aHeaderContentRow "\#include <$aForwardDeclClass.hxx>" |
467 | set aHeaderContent [lreplace $aHeaderContent $aHeaderLineIndex $aHeaderLineIndex $aHeaderContentRow] |
468 | } |
469 | } |
470 | } |
471 | |
472 | if {$aHeaderContentUpdated} { |
473 | loginfo "$aHeader updated" |
474 | SaveListToFile $aHeader $aHeaderContent $aHeaderEOL |
475 | } |
476 | } |
477 | } |
478 | } |
479 | |
480 | # Parse source files and: |
481 | # |
482 | # - add second argument to macro DEFINE_STANDARD_RTTI specifying first base |
483 | # class found in the class declaration; |
484 | # - replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx; |
485 | # - add #includes for all classes used as argument to macro |
486 | # STANDARD_TYPE(), except of already included ones |
487 | # |
488 | # If theCompatibleMode is false, in addition: |
489 | # - removes macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*(); |
490 | proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \ |
491 | theHeaderExtensions theSourceExtensions} { |
492 | |
493 | # iterate by header and source files |
494 | foreach aProcessedFile [glob -nocomplain -type f -directory $theProcessedPath *.{$theHeaderExtensions,$theSourceExtensions}] { |
495 | set aProcessedFileName [file tail $aProcessedFile] |
496 | |
497 | set aProcessedFileContent [ReadFileToRawText $aProcessedFile] |
498 | |
499 | # find all declarations of classes with public base in this header file; |
500 | # the result is stored in array inherits(class) |
501 | set index 0 |
502 | array unset inherits |
503 | set pattern_class {^\s*class\s+([A-Za-z_0-9:]+)\s*:\s*public\s+([A-Za-z_0-9:]+)\s*([,]?)} |
504 | while {[regexp -start $index -indices -lineanchor $pattern_class $aProcessedFileContent location class base comma]} { |
505 | set index [lindex $location 1] |
506 | |
507 | set class [eval string range \$aProcessedFileContent $class] |
508 | set base [eval string range \$aProcessedFileContent $base] |
509 | |
510 | if { [info exists inherits($class)] } { |
511 | set inherits($class,multiple) "found multiple declarations of class $class" |
512 | } else { |
513 | if { [lindex $comma 0] <= [lindex $comma 1] } { |
514 | set inherits($class,multiple) "class $class uses multiple inheritance" |
515 | } |
516 | set inherits($class) $base |
517 | } |
518 | } |
519 | |
520 | set change_flag 0 |
521 | |
522 | # find all instances of DEFINE_STANDARD_RTTI with single or two arguments |
523 | set index 0 |
524 | set pattern_rtti {^(\s*DEFINE_STANDARD_RTTI\s*)\(\s*([A-Za-z_0-9,\s]+)\s*\)} |
525 | while { [regexp -start $index -indices -lineanchor $pattern_rtti \ |
526 | $aProcessedFileContent location start clist] } { |
527 | set index [lindex $location 1] |
528 | |
529 | set start [eval string range \$aProcessedFileContent $start] |
530 | set clist [split [eval string range \$aProcessedFileContent $clist] ,] |
531 | |
532 | if { [llength $clist] == 1 } { |
533 | set class [string trim [lindex $clist 0]] |
534 | if { [info exists inherits($class)] } { |
535 | if { ! $theCheckMode } { |
536 | if { [info exists inherits($class,multiple)] } { |
537 | logwarn "Warning in $aProcessedFileName: $inherits($class,multiple);" |
538 | logwarn "macro DEFINE_STANDARD_RTTI is changed assuming it inherits $inherits($class), please check!" |
539 | } |
540 | set change_flag 1 |
541 | ReplaceSubString aProcessedFileContent $location "${start}($class, $inherits($class))" index |
542 | } |
543 | } else { |
544 | logwarn "Error in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file, cannot fix" |
545 | } |
546 | } elseif { [llength $clist] == 2 } { |
547 | set class [string trim [lindex $clist 0]] |
548 | set base [string trim [lindex $clist 1]] |
549 | if { ! [info exists inherits($class)] } { |
550 | logwarn "Warning in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file" |
551 | } elseif { $base != $inherits($class) } { |
552 | logwarn "Warning in $aProcessedFile: Second argument in macro DEFINE_STANDARD_RTTI for class $class is $base while $class seems to inherit from $inherits($class)" |
553 | if { ! $theCheckMode && ! [info exists inherits($class,multiple)] } { |
554 | set change_flag 1 |
555 | ReplaceSubString aProcessedFileContent $location "${start}($class, $inherits($class))" index |
556 | } |
557 | } |
558 | } |
559 | } |
560 | |
561 | # replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx |
562 | # set index 0 |
563 | # set pattern_definehandle {\#\s*include\s*<\s*Standard_DefineHandle.hxx\s*>} |
564 | # while { [regexp -start $index -indices -lineanchor $pattern_definehandle $aProcessedFileContent location] } { |
565 | # set index [lindex $location 1] |
566 | # if { ! $theCheckMode } { |
567 | # set change_flag 1 |
568 | # ReplaceSubString aProcessedFileContent $location "\#include <Standard_Type.hxx>" index |
569 | # incr index -1 |
570 | # } else { |
571 | # logwarn "Warning: $aProcessedFile contains obsolete forward declarations of Handle classes" |
572 | # break |
573 | # } |
574 | # } |
575 | |
576 | # remove macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*(); |
577 | if { ! $theCompatibleMode } { |
578 | set index 0 |
579 | set first_newline \n\n |
580 | set pattern_implement {\\?\n\s*IMPLEMENT_(DOWNCAST|STANDARD_[A-Z_]+|HARRAY1|HARRAY2|HUBTREE|HEBTREE|HSEQUENCE)\s*\([A-Za-z0-9_ ,]*\)\s*;?} |
581 | while { [regexp -start $index -indices -lineanchor $pattern_implement $aProcessedFileContent location] } { |
582 | set index [lindex $location 1] |
583 | if { ! $theCheckMode } { |
584 | set change_flag 1 |
585 | ReplaceSubString aProcessedFileContent $location $first_newline index |
586 | # set first_newline "" |
587 | incr index -1 |
588 | } else { |
589 | logwarn "Warning: $aProcessedFile contains deprecated macros IMPLEMENT_*" |
590 | break |
591 | } |
592 | } |
593 | } |
594 | |
595 | # find all uses of macro STANDARD_TYPE and method DownCast and ensure that |
596 | # argument class is explicitly included |
597 | set pattern_incbeg {\s*#\s*include\s*[\"<]\s*} |
598 | set pattern_incend {[.][a-zA-Z]+\s*[\">]} |
599 | set index 0 |
600 | set addtype {} |
601 | set pattern_type1 {STANDARD_TYPE\s*\(\s*([A-Za-z0-9_]+)\s*\)} |
602 | while { [regexp -start $index -indices $pattern_type1 $aProcessedFileContent location name] } { |
603 | set index [lindex $location 1] |
604 | set name [eval string range \$aProcessedFileContent $name] |
605 | if { ! [regexp -lineanchor "^${pattern_incbeg}${name}${pattern_incend}" $aProcessedFileContent] && |
606 | [lsearch -exact $addtype $name] < 0 && |
607 | [SearchForFile $theIncPaths $name.hxx]} { |
608 | lappend addtype $name |
609 | } |
610 | } |
611 | set pattern_type2 {Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*::\s*DownCast} |
612 | while { [regexp -start $index -indices $pattern_type2 $aProcessedFileContent location name] } { |
613 | set index [lindex $location 1] |
614 | set name [eval string range \$aProcessedFileContent $name] |
615 | if { ! [regexp -lineanchor "^${pattern_incbeg}${name}${pattern_incend}" $aProcessedFileContent] && |
616 | [lsearch -exact $addtype $name] < 0 && |
617 | [SearchForFile $theIncPaths $name.hxx]} { |
618 | lappend addtype $name |
619 | } |
620 | } |
621 | if { [llength $addtype] > 0 } { |
622 | if { ! $theCheckMode } { |
623 | set addinc "" |
624 | foreach type $addtype { |
625 | append addinc "\n#include <$type.hxx>" |
626 | } |
627 | if { [regexp -indices ".*\n${pattern_incbeg}\[A-Za-z0-9_/\]+${pattern_incend}" $aProcessedFileContent location] } { |
628 | set change_flag 1 |
629 | ReplaceSubString aProcessedFileContent $location "[eval string range \$aProcessedFileContent $location]$addinc" index |
630 | } else { |
631 | logerr "Error: $aProcessedFile: Cannot find #include statement to add more includes..." |
632 | } |
633 | } else { |
634 | logwarn "Warning: $aProcessedFile: The following class names are used as arguments of STANDARD_TYPE" |
635 | logwarn " macro, but not included directly: $addtype" |
636 | break |
637 | } |
638 | } |
639 | |
640 | # apply changes to the header file |
641 | if { $change_flag } { |
642 | SaveTextToFile $aProcessedFile $aProcessedFileContent |
643 | } |
644 | } |
645 | } |
646 | |
647 | # replace all forward declarations of "class Handle(...)" with fwd of "class ..." |
648 | proc ConvertHandle {theTargetPath theIncPaths theCheckMode theExtensions} { |
649 | |
650 | # iterate by header files |
651 | foreach aHeader [glob -nocomplain -type f -directory $theTargetPath *.{$theExtensions}] { |
652 | |
653 | # skip gxx files, as names Handle_xxx used there are in most cases |
654 | # placeholders of the argument types substituted by #define |
655 | if {[file extension $aHeader] == ".gxx"} { |
656 | continue |
657 | } |
658 | |
659 | # read the content of the header |
660 | if { [catch {set fd [open $aHeader rb]}] } { |
661 | logerr "Error: cannot open $aHeader" |
662 | continue |
663 | } |
664 | close $fd |
665 | |
666 | set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL] |
667 | |
668 | set anUpdateHeader false |
669 | |
670 | # if file contains "slots:" or "signals:", assume it defines some QObject |
671 | # class(es). |
672 | # In this case, type names "Handle_T" will not be replaced by Handle(T) to |
673 | # prevent failure of compilation of MOC code if such types are used in |
674 | # slots or signals (MOC does not expand macros). |
675 | # Forward declaration of a Handle will be then replaced by #include of |
676 | # corresponding class header (if such header is found), assuming that name |
677 | # typedefed Handle_T is defined in corresponding header (as typedef). |
678 | set isQObject [expr [regexp "Q_OBJECT" $aHeaderContent] && [regexp "(slots|signals)\s*:" $aHeaderContent]] |
679 | |
680 | # replace all IDs with prefix Handle_ by use of Handle() macro |
681 | if { ! $isQObject } { |
682 | set anUpdatedHeaderContent {} |
683 | set pattern_handle {\mHandle_([A-Za-z0-9_]+)} |
684 | foreach line $aHeaderContent { |
685 | # do not touch #include and #if... statements |
686 | if { [regexp {\s*\#\s*include} $line] || [regexp {\s*\#\s*if} $line] } { |
687 | lappend anUpdatedHeaderContent $line |
688 | continue |
689 | } |
690 | |
691 | # in other preprocessor statements, skip first expression to avoid |
692 | # replacements in #define Handle_... and similar cases |
693 | set index 0 |
694 | if { [regexp -indices {\s*#\s*[A-Za-z]+\s+[^\s]+} $line location] } { |
695 | set index [expr 1 + [lindex $location 1]] |
696 | } |
697 | |
698 | # replace Handle_T by Handle(T) |
699 | while { [regexp -start $index -indices $pattern_handle $line location class] } { |
700 | set index [lindex $location 1] |
701 | |
702 | set class [eval string range \$line $class] |
703 | # puts "Found: [eval string range \$line $location]" |
704 | |
705 | if { ! $theCheckMode } { |
706 | set anUpdateHeader true |
707 | ReplaceSubString line $location "Handle($class)" index |
708 | } else { |
709 | logwarn "Warning: $aHeader refers to IDs starting with \"Handle_\" which are likely" |
710 | logwarn " instances of OCCT Handle classes (e.g. \"$class\"); these are to be " |
711 | logwarn " replaced by template opencascade::handle<> or legacy macro Handle()" |
712 | set index -1 ;# to break outer cycle |
713 | break |
714 | } |
715 | } |
716 | lappend anUpdatedHeaderContent $line |
717 | |
718 | if { $index < 0 } { |
719 | set anUpdatedHeaderContent $aHeaderContent |
720 | break |
721 | } |
722 | } |
723 | set aHeaderContent $anUpdatedHeaderContent |
724 | } |
725 | |
726 | # replace NS::Handle(A) by Handle(NS::A) |
727 | set anUpdatedHeaderContent {} |
728 | set pattern_nshandle {([A-Za-z0-9_]+)\s*::\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)} |
729 | foreach line $aHeaderContent { |
730 | set index 0 |
731 | |
732 | while { [regexp -start $index -indices -lineanchor $pattern_nshandle $line location scope class]} { |
733 | set index [lindex $location 1] |
734 | |
735 | set scope [eval string range \$line $scope] |
736 | set class [eval string range \$line $class] |
737 | |
738 | if { ! $theCheckMode } { |
739 | set anUpdateHeader true |
740 | ReplaceSubString line $location "Handle(${scope}::${class})" index |
741 | } else { |
742 | logwarn "Warning in $aHeader: usage of Handle macro inside scope is incorrect: [eval string range \$line $location]" |
743 | set index -1 ;# to break outer cycle |
744 | break |
745 | } |
746 | } |
747 | lappend anUpdatedHeaderContent $line |
748 | |
749 | if { $index < 0 } { |
750 | set anUpdatedHeaderContent $aHeaderContent |
751 | break |
752 | } |
753 | } |
754 | set aHeaderContent $anUpdatedHeaderContent |
755 | |
756 | # remove all forward declarations of Handle classes |
757 | set anUpdatedHeaderContent {} |
758 | set aFwdHandlePattern {^\s*class\s+Handle[_\(]([A-Za-z0-9_]+)[\)]?\s*\;\s*$} |
759 | foreach aHeaderContentLine $aHeaderContent { |
760 | if {[regexp $aFwdHandlePattern $aHeaderContentLine dummy aForwardDeclHandledClass]} { |
761 | if {$theCheckMode} { |
762 | loginfo "Info: $aHeader contains statement involving forward decl of Handle_$aForwardDeclHandledClass" |
763 | } else { |
764 | # replace by forward declaration of a class or its include unless |
765 | # it is already declared or included |
766 | if { ! [regexp "^\s*\#\s*include\s*\[\<\"\]\s*$aForwardDeclHandledClass\s*\[\>\"\]" $aHeaderContent] } { |
767 | if { $isQObject } { |
768 | lappend anUpdatedHeaderContent "#include <${aForwardDeclHandledClass}.hxx>" |
769 | if { ! [SearchForFile $theIncPaths ${aForwardDeclHandledClass}.hxx] } { |
770 | loginfo "Warning: include ${aForwardDeclHandledClass}.hxx added in $aHeader, assuming it exists and defines Handle_$aForwardDeclHandledClass" |
771 | } |
772 | } elseif { ! [regexp "^\s*class\s+$aForwardDeclHandledClass\s*;" $aHeaderContent] } { |
773 | lappend anUpdatedHeaderContent "class $aForwardDeclHandledClass;" |
774 | } |
775 | } |
776 | set anUpdateHeader true |
777 | continue |
778 | } |
779 | } |
780 | lappend anUpdatedHeaderContent $aHeaderContentLine |
781 | } |
782 | set aHeaderContent $anUpdatedHeaderContent |
783 | |
784 | # remove all typedefs using Handle() macro to generate typedefed name |
785 | set anUpdatedHeaderContent {} |
786 | set aTypedefHandlePattern {^\s*typedef\s+[_A-Za-z\<\>, \s]+\s+Handle\([A-Za-z0-9_]+\)\s*\;\s*$} |
787 | foreach aHeaderContentLine $aHeaderContent { |
788 | if {[regexp $aTypedefHandlePattern $aHeaderContentLine aFoundPattern]} { |
789 | if {$theCheckMode} { |
790 | loginfo "Info: $aHeader contains typedef using Handle macro to generate name: $aFoundPattern" |
791 | } else { |
792 | set anUpdateHeader true |
793 | continue |
794 | } |
795 | } |
796 | lappend anUpdatedHeaderContent $aHeaderContentLine |
797 | } |
798 | set aHeaderContent $anUpdatedHeaderContent |
799 | |
800 | # remove all #include statements for files starting with "Handle_" |
801 | set anUpdatedHeaderContent {} |
802 | set anIncHandlePattern {^\s*\#\s*include\s+[\<\"]\s*(Handle[\(_][A-Za-z0-9_.]+[\)]?)\s*[\>\"]\s*$} |
803 | foreach aHeaderContentLine $aHeaderContent { |
804 | if {[regexp $anIncHandlePattern $aHeaderContentLine aFoundPattern anHxxName] && |
805 | ! [SearchForFile $theIncPaths $anHxxName]} { |
806 | if {$theCheckMode} { |
807 | loginfo "Info: $aHeader includes missing header: $anHxxName" |
808 | } else { |
809 | set anUpdateHeader true |
810 | continue |
811 | } |
812 | } |
813 | lappend anUpdatedHeaderContent $aHeaderContentLine |
814 | } |
815 | |
816 | # save result |
817 | if {$anUpdateHeader} { |
818 | SaveListToFile $aHeader $anUpdatedHeaderContent $aHeaderEOL |
819 | } |
820 | } |
821 | } |
822 | |
823 | # Replaces C-style casts of Handle object to Handle to derived type |
824 | # by call to DownCast() method |
825 | proc ConvertCStyleHandleCast {pkpath theExtensions theCheckMode} { |
826 | |
827 | # iterate by header files |
828 | foreach afile [glob -nocomplain -type f -directory $pkpath *.\{$theExtensions\}] { |
829 | set hxx [ReadFileToRawText $afile] |
830 | |
831 | set change_flag 0 |
832 | |
833 | # replace ((Handle(A)&)b) by Handle(A)::DownCast(b) |
834 | set index 0 |
835 | set pattern_refcast1 {\(\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)\)} |
836 | while { [regexp -start $index -indices -lineanchor $pattern_refcast1 $hxx location class var]} { |
837 | set index [lindex $location 1] |
838 | |
839 | set class [eval string range \$hxx $class] |
840 | set var [eval string range \$hxx $var] |
841 | |
842 | if { ! $theCheckMode } { |
843 | set change_flag 1 |
844 | ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index |
845 | } else { |
846 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
847 | } |
848 | } |
849 | |
850 | # replace (Handle(A)&)b, by Handle(A)::DownCast(b), |
851 | # replace (Handle(A)&)b; by Handle(A)::DownCast(b); |
852 | # replace (Handle(A)&)b) by Handle(A)::DownCast(b)) |
853 | set index 0 |
854 | set pattern_refcast2 {\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)(\s*[,;\)])} |
855 | while { [regexp -start $index -indices -lineanchor $pattern_refcast2 $hxx location class var end]} { |
856 | set index [lindex $location 1] |
857 | |
858 | set class [eval string range \$hxx $class] |
859 | set var [eval string range \$hxx $var] |
860 | set end [eval string range \$hxx $end] |
861 | |
862 | if { ! $theCheckMode } { |
863 | set change_flag 1 |
864 | ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index |
865 | } else { |
866 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
867 | } |
868 | } |
869 | |
870 | # replace (*((Handle(A)*)&b)) by Handle(A)::DownCast(b) |
871 | set index 0 |
872 | set pattern_ptrcast1 {([^A-Za-z0-9_]\s*)\(\s*[*]\s*\(\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*\)\s*\)} |
873 | while { [regexp -start $index -indices -lineanchor $pattern_ptrcast1 $hxx location start class var] } { |
874 | set index [lindex $location 1] |
875 | |
876 | set start [eval string range \$hxx $start] |
877 | set class [eval string range \$hxx $class] |
878 | set var [eval string range \$hxx $var] |
879 | |
880 | if { ! $theCheckMode } { |
881 | set change_flag 1 |
882 | ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index |
883 | } else { |
884 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
885 | } |
886 | } |
887 | |
888 | # replace *((Handle(A)*)&b) by Handle(A)::DownCast(b) |
889 | set index 0 |
890 | set pattern_ptrcast2 {[*]\s*\(\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*\)} |
891 | while { [regexp -start $index -indices -lineanchor $pattern_ptrcast2 $hxx location class var] } { |
892 | set index [lindex $location 1] |
893 | |
894 | set class [eval string range \$hxx $class] |
895 | set var [eval string range \$hxx $var] |
896 | |
897 | if { ! $theCheckMode } { |
898 | set change_flag 1 |
899 | ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index |
900 | } else { |
901 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
902 | } |
903 | } |
904 | |
905 | # replace (*(Handle(A)*)&b) by Handle(A)::DownCast(b) |
906 | set index 0 |
907 | set pattern_ptrcast3 {([^A-Za-z0-9_]\s*)\(\s*[*]\s*\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*\)} |
908 | while { [regexp -start $index -indices -lineanchor $pattern_ptrcast3 $hxx location start class var] } { |
909 | set index [lindex $location 1] |
910 | |
911 | set start [eval string range \$hxx $start] |
912 | set class [eval string range \$hxx $class] |
913 | set var [eval string range \$hxx $var] |
914 | |
915 | if { ! $theCheckMode } { |
916 | set change_flag 1 |
917 | ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index |
918 | } else { |
919 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
920 | } |
921 | } |
922 | |
923 | # replace *(Handle(A)*)&b, by Handle(A)::DownCast(b), |
924 | # replace *(Handle(A)*)&b; by Handle(A)::DownCast(b); |
925 | # replace *(Handle(A)*)&b) by Handle(A)::DownCast(b)) |
926 | set index 0 |
927 | set pattern_ptrcast4 {[*]\s*\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)(\s*[,;\)])} |
928 | while { [regexp -start $index -indices -lineanchor $pattern_ptrcast4 $hxx location class var end] } { |
929 | set index [lindex $location 1] |
930 | |
931 | set class [eval string range \$hxx $class] |
932 | set var [eval string range \$hxx $var] |
933 | set end [eval string range \$hxx $end] |
934 | |
935 | if { ! $theCheckMode } { |
936 | set change_flag 1 |
937 | ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index |
938 | } else { |
939 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
940 | } |
941 | } |
942 | |
943 | # just warn if some casts to & are still there |
944 | set index 0 |
945 | set pattern_refcast0 {\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)} |
946 | while { [regexp -start $index -indices -lineanchor $pattern_refcast0 $hxx location class var] } { |
947 | set index [lindex $location 1] |
948 | |
949 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
950 | } |
951 | |
952 | # replace const Handle(A)& a = Handle(B)::DownCast (b); by |
953 | # Handle(A) a ( Handle(B)::DownCast (b) ); |
954 | set index 0 |
955 | set pattern_refvar {\mconst\s+Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*=\s*(Handle\s*\(\s*[A-Za-z0-9_]+\s*\)\s*::\s*DownCast\s*\([^;]+);} |
956 | while { [regexp -start $index -indices -lineanchor $pattern_refvar $hxx location class var hexpr] } { |
957 | set index [lindex $location 1] |
958 | |
959 | set class [eval string range \$hxx $class] |
960 | set var [eval string range \$hxx $var] |
961 | set hexpr [eval string range \$hxx $hexpr] |
962 | |
963 | if { ! $theCheckMode } { |
964 | set change_flag 1 |
965 | ReplaceSubString hxx $location "Handle($class) $var ($hexpr);" index |
966 | } else { |
967 | logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]" |
968 | } |
969 | } |
970 | |
971 | # apply changes to the header file |
972 | if { $change_flag } { |
973 | SaveTextToFile $afile $hxx |
974 | } |
975 | } |
976 | } |
977 | |
978 | # Remove unnecessary forward declaration of a class if found immediately before |
979 | # its use in DEFINE_STANDARD_HANDLE |
980 | proc RemoveFwdClassForDefineStandardHandle {pkpath theCheckMode} { |
981 | |
982 | # iterate by header files |
983 | foreach afile [glob -nocomplain -type f -directory $pkpath *.?xx] { |
984 | |
985 | # load a file |
986 | if { [catch {set fd [open $afile rb]}] } { |
987 | logerr "Error: cannot open $afile" |
988 | continue |
989 | } |
990 | set hxx [read $fd] |
991 | close $fd |
992 | |
993 | set change_flag 0 |
994 | |
995 | # replace |
996 | set index 0 |
997 | set pattern_fwddef {class\s+([A-Za-z0-9_]+)\s*;\s*DEFINE_STANDARD_HANDLE\s*\(\s*([A-Za-z0-9_]+)\s*,\s*([A-Za-z0-9_]+)\s*\)[ \t]*} |
998 | while { [regexp -start $index -indices -lineanchor $pattern_fwddef $aProcessedFileContent location fwdclass class1 class2] } { |
999 | set index [lindex $location 1] |
1000 | |
1001 | set fwdclass [eval string range \$aProcessedFileContent $fwdclass] |
1002 | set class1 [eval string range \$aProcessedFileContent $class1] |
1003 | set class2 [eval string range \$aProcessedFileContent $class2] |
1004 | |
1005 | if { $fwdclass != $class1 } { |
1006 | continue |
1007 | } |
1008 | |
1009 | if { ! $theCheckMode } { |
1010 | set change_flag 1 |
1011 | ReplaceSubString aProcessedFileContent $location "DEFINE_STANDARD_HANDLE($class1, $class2)" index |
1012 | incr index -1 |
1013 | } else { |
1014 | logwarn "Warning: $aProcessedFile contains unnecessary forward declarations of class $fwdclass" |
1015 | break |
1016 | } |
1017 | } |
1018 | |
1019 | # apply changes to the header file |
1020 | if { $change_flag } { |
1021 | SaveTextToFile $afile $hxx |
1022 | } |
1023 | } |
1024 | } |
1025 | |
1026 | # auxiliary: modifies variable text_var replacing part defined by two indices |
1027 | # given in location by string str, and updates index_var variable to point to |
1028 | # the end of the replaced string. Variable flag_var is set to 1. |
1029 | proc ReplaceSubString {theSource theLocation theSubstitute theEndIndex} { |
1030 | |
1031 | upvar $theSource aSource |
1032 | upvar $theEndIndex anEndIndex |
1033 | |
1034 | set aStartIndex [lindex $theLocation 0] |
1035 | set anEndIndex [lindex $theLocation 1] |
1036 | set aSource [string replace "$aSource" $aStartIndex $anEndIndex "$theSubstitute"] |
1037 | set anEndIndex [expr $aStartIndex + [string length $theSubstitute]] |
1038 | } |
1039 | |
1040 | # Save theFileContent some text to theFilePath file |
1041 | proc SaveTextToFile {theFilePath theFileContent} { |
1042 | if { [catch {set aFile [open ${theFilePath} w];} aReason] } { |
1043 | logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason" |
1044 | return |
1045 | } |
1046 | |
1047 | fconfigure $aFile -translation binary |
1048 | puts -nonewline $aFile "$theFileContent" |
1049 | close $aFile |
1050 | |
1051 | loginfo "File $theFilePath modified" |
1052 | } |
1053 | |
1054 | # read content from theFilePath to list, theFileContent is a raw content of the file |
1055 | proc ReadFileToList {theFilePath theFileContent theFileEOL} { |
1056 | upvar $theFileContent aFileContent |
1057 | upvar $theFileEOL aFileEOL |
1058 | |
1059 | if {"$theFilePath" == "" || ![file exists $theFilePath]} { |
1060 | return |
1061 | } |
1062 | |
1063 | if { [catch {set aFile [open ${theFilePath} r]} aReason] } { |
1064 | logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason" |
1065 | return |
1066 | } |
1067 | |
1068 | fconfigure $aFile -translation binary |
1069 | set aFileContent [read $aFile] |
1070 | close $aFile |
1071 | |
1072 | set aFileEOL "\r" |
1073 | if [regexp "\r\n" $aFileContent] { |
1074 | set aFileEOL "\r\n" |
1075 | } elseif [regexp "\n" $aFileContent] { |
1076 | set aFileEOL "\n" |
1077 | } |
1078 | |
1079 | # convert to unix eol |
1080 | if {"$aFileEOL" != "\n"} { |
1081 | regsub -all {$aFileEOL} $aFileContent "\n" aFileContent |
1082 | } |
1083 | |
1084 | set aList {} |
1085 | foreach aLine [split $aFileContent "\n"] { |
1086 | lappend aList [string trimright $aLine] |
1087 | } |
1088 | |
1089 | return $aList |
1090 | } |
1091 | |
1092 | # read content from theFilePath to raw text (with unix eol) |
1093 | proc ReadFileToRawText {theFilePath} { |
1094 | if {"$theFilePath" == "" || ![file exists $theFilePath]} { |
1095 | return |
1096 | } |
1097 | |
1098 | if { [catch {set aFile [open ${theFilePath} r]} aReason] } { |
1099 | logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason" |
1100 | return |
1101 | } |
1102 | |
1103 | fconfigure $aFile -translation binary |
1104 | set aFileContent [read $aFile] |
1105 | close $aFile |
1106 | |
1107 | set aFileEOL "\r" |
1108 | if [regexp "\r\n" $aFileContent] { |
1109 | set aFileEOL "\r\n" |
1110 | } elseif [regexp "\n" $aFileContent] { |
1111 | set aFileEOL "\n" |
1112 | } |
1113 | |
1114 | # convert to unix eol |
1115 | if {"$aFileEOL" != "\n"} { |
1116 | regsub -all {$aFileEOL} $aFileContent "\n" aFileContent |
1117 | } |
1118 | |
1119 | return $aFileContent |
1120 | } |
1121 | |
1122 | # auxiliary: saves content of "theData" list to "theFilePath" |
1123 | proc SaveListToFile {theFilePath theData {theEOL "auto"}} { |
1124 | set anUsedEol $theEOL |
1125 | |
1126 | if {"$anUsedEol" == ""} { |
1127 | set anUsedEol "auto" |
1128 | } |
1129 | |
1130 | # if the file exists and "eol choice" is "auto", detect the file eol |
1131 | if {$anUsedEol == "auto" && [file exists $theFilePath]} { |
1132 | if { [catch {set aFile [open ${theFilePath} r]} aReason] } { |
1133 | logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason" |
1134 | } else { |
1135 | fconfigure $aFile -translation binary |
1136 | set aFileContent [read $aFile] |
1137 | close $aFile |
1138 | |
1139 | set anUsedEol "\r" |
1140 | if [regexp "\r\n" $aFileContent] { |
1141 | set anUsedEol "\r\n" |
1142 | } elseif [regexp "\n" $aFileContent] { |
1143 | set anUsedEol "\n" |
1144 | } |
1145 | } |
1146 | } |
1147 | |
1148 | # write |
1149 | if { [catch {set aFile [open ${theFilePath} w];} aReason] } { |
1150 | logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason" |
1151 | return |
1152 | } |
1153 | |
1154 | fconfigure $aFile -translation binary |
1155 | puts -nonewline $aFile [join $theData $anUsedEol] |
1156 | close $aFile |
1157 | } |
1158 | |
1159 | # collect all subdirs of theBaseDir |
1160 | proc CollectDirStructure {theBaseDir} { |
1161 | set aDirs [glob -nocomplain -directory $theBaseDir -type d *] |
1162 | |
1163 | set aSubDirs {} |
1164 | foreach aDir $aDirs { |
1165 | foreach aSubDir [CollectDirStructure $aDir] { |
1166 | lappend aSubDirs $aSubDir |
1167 | } |
1168 | } |
1169 | |
1170 | foreach aSubDir $aSubDirs { |
1171 | lappend aDirs $aSubDir |
1172 | } |
1173 | |
1174 | return $aDirs |
1175 | } |
1176 | |
1177 | # check existence of theFileName file in several folders (theIncPaths) |
1178 | proc SearchForFile {theIncPaths theFileName} { |
1179 | foreach aPath $theIncPaths { |
1180 | if {[file exists "${aPath}/${theFileName}"]} { |
1181 | return true |
1182 | } |
1183 | } |
1184 | |
1185 | return false |
1186 | } |
1187 | |
1188 | # auxiliary: parse the string to comment and not comment parts |
1189 | # variable "_cmnt" should be created before using the operation, it will save comment part of line |
1190 | # variable "_isMulti" should be created before the loop, equal to "false" if first line in the loop is not multi-comment line |
1191 | proc _check_line { line } { |
1192 | upvar _isMulti _isMulti |
1193 | upvar _cmnt _cmnt |
1194 | |
1195 | set string_length [string length $line] |
1196 | set c_b $string_length |
1197 | set mc_b $string_length |
1198 | set mc_e $string_length |
1199 | regexp -indices {//} $line c_b |
1200 | regexp -indices {/\*} $line mc_b |
1201 | regexp -indices {\*/} $line mc_e |
1202 | if {!${_isMulti}} { |
1203 | if {[lindex $c_b 0] < [lindex $mc_b 0] && [lindex $c_b 0] < [lindex $mc_e 0]} { |
1204 | set notComment_c [string range $line 0 [expr [lindex $c_b 0]-1]] |
1205 | set Comment_c [string range $line [lindex $c_b 0] end] |
1206 | set _cmnt $_cmnt$Comment_c |
1207 | return $notComment_c |
1208 | } elseif {[lindex $mc_b 0] < [lindex $c_b 0] && [lindex $mc_b 0] < [lindex $mc_e 0]} { |
1209 | set _isMulti true |
1210 | set _cmnt "${_cmnt}/*" |
1211 | set notComment_mc [string range $line 0 [expr [lindex $mc_b 0]-1]] |
1212 | set Comment_mc [string range $line [expr [lindex $mc_b 1]+1] end] |
1213 | return [_check_line "${notComment_mc}[_check_line ${Comment_mc}]"] |
1214 | } elseif {[lindex $mc_e 0] < [lindex $c_b 0] && [lindex $mc_e 0] < [lindex $mc_b 0]} { |
1215 | set notComment_mc [string range $line [expr [lindex $mc_e 1]+1] end] |
1216 | set Comment_mc [string range $line 0 [expr [lindex $mc_e 0]-1]] |
1217 | set _cmnt "${_cmnt}${Comment_mc}*/" |
1218 | set chk [_check_line ${notComment_mc}] |
1219 | set _isMulti true |
1220 | return $chk |
1221 | } |
1222 | } else { |
1223 | if {[lindex $mc_e 0] < [lindex $mc_b 0]} { |
1224 | set _isMulti false |
1225 | set Comment_mc [string range $line 0 [lindex $mc_e 1]] |
1226 | set notComment_mc [string range $line [expr [lindex $mc_e 1]+1] end] |
1227 | set _cmnt $_cmnt$Comment_mc |
1228 | return [_check_line $notComment_mc] |
1229 | } elseif {[lindex $mc_b 0] < [lindex $mc_e 0] } { |
1230 | set notComment_mc [string range $line 0 [expr [lindex $mc_b 0]-1]] |
1231 | set Comment_mc [string range $line [expr [lindex $mc_b 1]+1] end] |
1232 | set _cmnt "${_cmnt}/*" |
1233 | set chk [_check_line "${notComment_mc}[_check_line ${Comment_mc}]"] |
1234 | set _isMulti false |
1235 | return $chk |
1236 | } else { |
1237 | set _cmnt $_cmnt$line |
1238 | return "" |
1239 | } |
1240 | } |
1241 | return $line |
1242 | } |
1243 | |
1244 | # Create Tk-based logger which allows convenient consulting the upgrade process. |
1245 | proc _create_logger {} { |
1246 | if { [catch {winfo exists .h}] } { |
1247 | logerr "Error: Tk commands are not available, cannot create UI!" |
1248 | return |
1249 | } |
1250 | |
1251 | if { ![winfo exists .h ] } { |
1252 | toplevel .h |
1253 | wm title .h "Conversion log" |
1254 | wm geometry .h +320+200 |
1255 | wm resizable .h 0 0 |
1256 | |
1257 | text .h.t -yscrollcommand {.h.sbar set} |
1258 | scrollbar .h.sbar -orient vertical -command {.h.t yview} |
1259 | |
1260 | pack .h.sbar -side right -fill y |
1261 | pack .h.t |
1262 | } |
1263 | } |
1264 | |
1265 | set LogFilePath "" |
1266 | |
1267 | # Puts the passed string into Tk-based logger highlighting it with the |
1268 | # given color for better view. If no logger exists (-wlog option was not |
1269 | # activated), the standard output is used. |
1270 | proc _logcommon {theLogMessage {theMessageColor ""}} { |
1271 | global LogFilePath |
1272 | |
1273 | if {"$LogFilePath" != ""} { |
1274 | if { ! [catch {set aLogFile [open ${LogFilePath} a];} aReason] } { |
1275 | set t [clock milliseconds] |
1276 | set aTimeAndMessage [format "\[%s\] %s" \ |
1277 | [clock format [expr {$t / 1000}] -format %T] \ |
1278 | $theLogMessage \ |
1279 | ] |
1280 | |
1281 | |
1282 | puts $aLogFile $aTimeAndMessage |
1283 | close $aLogFile |
1284 | } else { |
1285 | logerr "Error: cannot open $LogFilePath log file due to $aReason" |
1286 | } |
1287 | } |
1288 | |
1289 | if { ! [catch {winfo exists .h} res] && $res } { |
1290 | .h.t insert end "$theLogMessage\n" |
1291 | |
1292 | if {$theLogMessage != ""} { |
1293 | # We use the current number of lines to generate unique tag in the text |
1294 | set aLineNb [lindex [split [.h.t index "end - 1 line"] "."] 0] |
1295 | |
1296 | .h.t tag add my_tag_$aLineNb end-2l end-1l |
1297 | .h.t tag configure my_tag_$aLineNb -background $theMessageColor |
1298 | } |
1299 | |
1300 | update |
1301 | } else { |
1302 | puts $theLogMessage |
1303 | } |
1304 | } |
1305 | |
1306 | # Puts information message to logger. |
1307 | proc loginfo {a} { |
1308 | _logcommon $a |
1309 | } |
1310 | |
1311 | # Puts warning message to logger. |
1312 | proc logwarn {a} { |
1313 | _logcommon $a "pink" |
1314 | } |
1315 | |
1316 | # Puts error message to logger. |
1317 | proc logerr {a} { |
1318 | _logcommon $a "red" |
1319 | } |