0030579: Draw Harness, Draw_Interpretor - catch exceptions other than Standard_Failure
[occt.git] / adm / upgrade.tcl
CommitLineData
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
6set ArgName(HelpInfo) "h"
7
8set ArgName(SourceCode) "src"
9set ArgName(IncPath) "inc"
10
11set ArgName(IncExtension) "incext"
12set ArgName(SrcExtension) "srcext"
13
14set ArgName(RTTI) "rtti"
15
16set ArgName(CStyleCastHandle) "handlecast"
17set ArgName(All) "all"
18
19set ArgName(Handle) "handle"
20set ArgName(TCollection) "tcollection"
21
22set ArgName(CompatibleMode) "compat"
23
24set ArgName(Recurse) "recurse"
25set ArgName(Rename) "rename"
26
27set ArgName(CheckOnly) "check"
28set ArgName(WLog) "wlog"
29set ArgName(Log) "log"
30
31proc 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
63proc 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
105proc 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
158set DataSectionName(TCollection) "tcollection"
159set DataSectionName(Rename) "rename"
160
161proc DataFileName {} {
162 return [file join [file dirname [info script]] upgrade.dat]
163}
164
165proc IsDataFileExist {} {
166 return [file exists [DataFileName]]
167}
168
169proc 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
202proc 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.
246proc 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
375proc 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
412proc 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
f5f4ebd0 480# try to find source file corresponding to the specified header and either
481# inject macro IMPLEMENT_STANDARD_RTTIEXT in it, or check it already present,
482# and depending on this, return suffix to be used for corresponding macro
483# DEFINE_STANDARD_RTTI... (either inline or out-of-line variant)
484proc DefineExplicitRtti {hxxfile class base theSourceExtensions} {
485 # if current file is not a header (by extension), exit with "inline" variant
486 # (there is no need to bother with out-of-line instantiations for local class)
487 set ext [string range [file extension $hxxfile] 1 end]
488 if { [lsearch -exact [split $theSourceExtensions ,] $ext] >=0 } {
489 return "_INLINE"
490 }
491
492 # try to find source file with the same name but source-type extension
493 # in the same folder
494 set filename [file rootname $hxxfile]
495 foreach ext [split $theSourceExtensions ,] {
496# puts "Checking ${filename}.$ext"
497 if { ! [file readable ${filename}.$ext] } { continue }
498
499 # check the file content
500 set aFileContent [ReadFileToList ${filename}.$ext aFileRawContent aEOL]
501
502 # try to find existing macro IMPLEMENT_STANDARD_RTTIEXT and check that
503 # it is consistent
504 foreach line $aFileContent {
505 if { [regexp "^\\s*IMPLEMENT_STANDARD_RTTIEXT\\s*\\(\\s*$class\\s*,\\s*(\[A-Za-z0-9_\]+)\\s*\\)" $line res impl_base] } {
506 # implementation is in place, just report warning if second argument
507 # is different
508 if { $base != $impl_base } {
509 logwarn "Warning in ${filename}.$ext: second argument of macro"
510 logwarn " IMPLEMENT_STANDARD_RTTIEXT($class,$impl_base)"
511 logwarn " is not the same as detected base class, $base"
512 }
513 return "EXT"
514 }
515 }
516
517 # inject a new macro before the first non-empty, non-comment, and
518 # non-preprocessor line
519 set aNewFileContent {}
520 set injected 0
521 set inc_found 0
522 foreach line $aFileContent {
523 if { ! $injected } {
524 # add macro before first non-empty line after #includes
525 if { [regexp {^\s*$} $line] } {
526 } elseif { [regexp {^\s*\#\s*include} $line] } {
527 set inc_found 1
528 } elseif { $inc_found } {
529 set injected 1
530 lappend aNewFileContent "IMPLEMENT_STANDARD_RTTIEXT($class,$base)"
531 if { ! [regexp "^IMPLEMENT_" $line] } {
532 lappend aNewFileContent ""
533 }
534 }
535 }
536 lappend aNewFileContent $line
537 }
538 if { ! $injected } {
539 lappend aNewFileContent "IMPLEMENT_STANDARD_RTTIEXT($class,$base)"
540 }
541 SaveListToFile ${filename}.$ext $aNewFileContent $aEOL
542
543 return "EXT"
544 }
545
546 logwarn "Warning in ${hxxfile}: cannot find corresponding source file,"
547 logwarn " will use inline version of DEFINE_STANDARD_RTTI"
548 return "_INLINE"
549}
550
d1a67b9d 551# Parse source files and:
552#
553# - add second argument to macro DEFINE_STANDARD_RTTI specifying first base
554# class found in the class declaration;
555# - replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx;
556# - add #includes for all classes used as argument to macro
557# STANDARD_TYPE(), except of already included ones
558#
559# If theCompatibleMode is false, in addition:
560# - removes macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*();
561proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \
562 theHeaderExtensions theSourceExtensions} {
563
564 # iterate by header and source files
565 foreach aProcessedFile [glob -nocomplain -type f -directory $theProcessedPath *.{$theHeaderExtensions,$theSourceExtensions}] {
566 set aProcessedFileName [file tail $aProcessedFile]
567
568 set aProcessedFileContent [ReadFileToRawText $aProcessedFile]
569
570 # find all declarations of classes with public base in this header file;
571 # the result is stored in array inherits(class)
572 set index 0
573 array unset inherits
574 set pattern_class {^\s*class\s+([A-Za-z_0-9:]+)\s*:\s*public\s+([A-Za-z_0-9:]+)\s*([,]?)}
575 while {[regexp -start $index -indices -lineanchor $pattern_class $aProcessedFileContent location class base comma]} {
576 set index [lindex $location 1]
577
578 set class [eval string range \$aProcessedFileContent $class]
579 set base [eval string range \$aProcessedFileContent $base]
580
581 if { [info exists inherits($class)] } {
582 set inherits($class,multiple) "found multiple declarations of class $class"
583 } else {
584 if { [lindex $comma 0] <= [lindex $comma 1] } {
585 set inherits($class,multiple) "class $class uses multiple inheritance"
586 }
587 set inherits($class) $base
588 }
589 }
590
591 set change_flag 0
592
593 # find all instances of DEFINE_STANDARD_RTTI with single or two arguments
594 set index 0
f5f4ebd0 595 set pattern_rtti {^(\s*DEFINE_STANDARD_RTTI)([_A-Z]+)?\s*\(\s*([A-Za-z_0-9,\s]+)\s*\)}
d1a67b9d 596 while { [regexp -start $index -indices -lineanchor $pattern_rtti \
f5f4ebd0 597 $aProcessedFileContent location start suffix clist] } {
d1a67b9d 598 set index [lindex $location 1]
599
f5f4ebd0 600 set start [eval string range \$aProcessedFileContent $start]
601 set suffix [eval string range \$aProcessedFileContent $suffix]
602 set clist [split [eval string range \$aProcessedFileContent $clist] ,]
d1a67b9d 603
604 if { [llength $clist] == 1 } {
605 set class [string trim [lindex $clist 0]]
606 if { [info exists inherits($class)] } {
607 if { ! $theCheckMode } {
608 if { [info exists inherits($class,multiple)] } {
609 logwarn "Warning in $aProcessedFileName: $inherits($class,multiple);"
610 logwarn "macro DEFINE_STANDARD_RTTI is changed assuming it inherits $inherits($class), please check!"
611 }
612 set change_flag 1
f5f4ebd0 613 ReplaceSubString aProcessedFileContent $location \
614 "${start}EXT($class,$inherits($class))" index
d1a67b9d 615 }
616 } else {
617 logwarn "Error in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file, cannot fix"
618 }
619 } elseif { [llength $clist] == 2 } {
620 set class [string trim [lindex $clist 0]]
621 set base [string trim [lindex $clist 1]]
622 if { ! [info exists inherits($class)] } {
623 logwarn "Warning in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file"
f5f4ebd0 624 } elseif { $base != $inherits($class) && ! [info exists inherits($class,multiple)] } {
d1a67b9d 625 logwarn "Warning in $aProcessedFile: Second argument in macro DEFINE_STANDARD_RTTI for class $class is $base while $class seems to inherit from $inherits($class)"
f5f4ebd0 626 }
627 # convert intermediate version of macro DEFINE_STANDARD_RTTI
628 # with two arguments to either _INLINE or EXT variant
629 if { ! $theCheckMode && "$suffix" == "" } {
630 set change_flag 1
631 # try to inject macro IMPLEMENT_STANDARD_RTTIEXT in the
632 # corresponding source file (or check it already present),
633 # and depending on this, use either inline or out-of-line variant
634 set rtti_suffix [DefineExplicitRtti $aProcessedFile $class $base $theSourceExtensions]
635 ReplaceSubString aProcessedFileContent $location \
636 "${start}${rtti_suffix}($class,$base)" index
d1a67b9d 637 }
638 }
639 }
640
641 # replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx
642# set index 0
643# set pattern_definehandle {\#\s*include\s*<\s*Standard_DefineHandle.hxx\s*>}
644# while { [regexp -start $index -indices -lineanchor $pattern_definehandle $aProcessedFileContent location] } {
645# set index [lindex $location 1]
646# if { ! $theCheckMode } {
647# set change_flag 1
648# ReplaceSubString aProcessedFileContent $location "\#include <Standard_Type.hxx>" index
649# incr index -1
650# } else {
651# logwarn "Warning: $aProcessedFile contains obsolete forward declarations of Handle classes"
652# break
653# }
654# }
655
656 # remove macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*();
657 if { ! $theCompatibleMode } {
658 set index 0
659 set first_newline \n\n
660 set pattern_implement {\\?\n\s*IMPLEMENT_(DOWNCAST|STANDARD_[A-Z_]+|HARRAY1|HARRAY2|HUBTREE|HEBTREE|HSEQUENCE)\s*\([A-Za-z0-9_ ,]*\)\s*;?}
f5f4ebd0 661 while { [regexp -start $index -indices -lineanchor $pattern_implement $aProcessedFileContent location macro] } {
d1a67b9d 662 set index [lindex $location 1]
f5f4ebd0 663 # macro IMPLEMENT_STANDARD_RTTIEXT is retained
664 if { [eval string range \$aProcessedFileContent $macro] == "STANDARD_RTTIEXT" } {
665 continue
666 }
d1a67b9d 667 if { ! $theCheckMode } {
668 set change_flag 1
669 ReplaceSubString aProcessedFileContent $location $first_newline index
670# set first_newline ""
671 incr index -1
672 } else {
673 logwarn "Warning: $aProcessedFile contains deprecated macros IMPLEMENT_*"
674 break
675 }
676 }
677 }
678
679 # find all uses of macro STANDARD_TYPE and method DownCast and ensure that
680 # argument class is explicitly included
f5f4ebd0 681 set pattern_incbeg {\s*#\s*include\s*[\"<]\s*([A-Za-z0-9_/]*/)?}
d1a67b9d 682 set pattern_incend {[.][a-zA-Z]+\s*[\">]}
683 set index 0
684 set addtype {}
685 set pattern_type1 {STANDARD_TYPE\s*\(\s*([A-Za-z0-9_]+)\s*\)}
686 while { [regexp -start $index -indices $pattern_type1 $aProcessedFileContent location name] } {
687 set index [lindex $location 1]
688 set name [eval string range \$aProcessedFileContent $name]
689 if { ! [regexp -lineanchor "^${pattern_incbeg}${name}${pattern_incend}" $aProcessedFileContent] &&
690 [lsearch -exact $addtype $name] < 0 &&
691 [SearchForFile $theIncPaths $name.hxx]} {
692 lappend addtype $name
693 }
694 }
695 set pattern_type2 {Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*::\s*DownCast}
696 while { [regexp -start $index -indices $pattern_type2 $aProcessedFileContent location name] } {
697 set index [lindex $location 1]
698 set name [eval string range \$aProcessedFileContent $name]
699 if { ! [regexp -lineanchor "^${pattern_incbeg}${name}${pattern_incend}" $aProcessedFileContent] &&
700 [lsearch -exact $addtype $name] < 0 &&
701 [SearchForFile $theIncPaths $name.hxx]} {
702 lappend addtype $name
703 }
704 }
705 if { [llength $addtype] > 0 } {
706 if { ! $theCheckMode } {
707 set addinc ""
708 foreach type $addtype {
f5f4ebd0 709 if { "$aProcessedFileName" != "$type.hxx" } {
710 append addinc "\n#include <$type.hxx>"
711 }
d1a67b9d 712 }
713 if { [regexp -indices ".*\n${pattern_incbeg}\[A-Za-z0-9_/\]+${pattern_incend}" $aProcessedFileContent location] } {
714 set change_flag 1
715 ReplaceSubString aProcessedFileContent $location "[eval string range \$aProcessedFileContent $location]$addinc" index
716 } else {
717 logerr "Error: $aProcessedFile: Cannot find #include statement to add more includes..."
718 }
719 } else {
720 logwarn "Warning: $aProcessedFile: The following class names are used as arguments of STANDARD_TYPE"
721 logwarn " macro, but not included directly: $addtype"
722 break
723 }
724 }
725
726 # apply changes to the header file
727 if { $change_flag } {
728 SaveTextToFile $aProcessedFile $aProcessedFileContent
729 }
730 }
731}
732
733# replace all forward declarations of "class Handle(...)" with fwd of "class ..."
734proc ConvertHandle {theTargetPath theIncPaths theCheckMode theExtensions} {
735
736 # iterate by header files
737 foreach aHeader [glob -nocomplain -type f -directory $theTargetPath *.{$theExtensions}] {
f5f4ebd0 738 set aCurrentHeaderName [file tail $aHeader]
d1a67b9d 739
740 # skip gxx files, as names Handle_xxx used there are in most cases
741 # placeholders of the argument types substituted by #define
742 if {[file extension $aHeader] == ".gxx"} {
743 continue
744 }
745
746 # read the content of the header
747 if { [catch {set fd [open $aHeader rb]}] } {
748 logerr "Error: cannot open $aHeader"
749 continue
750 }
751 close $fd
752
753 set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL]
754
755 set anUpdateHeader false
756
757 # if file contains "slots:" or "signals:", assume it defines some QObject
758 # class(es).
759 # In this case, type names "Handle_T" will not be replaced by Handle(T) to
760 # prevent failure of compilation of MOC code if such types are used in
761 # slots or signals (MOC does not expand macros).
762 # Forward declaration of a Handle will be then replaced by #include of
763 # corresponding class header (if such header is found), assuming that name
764 # typedefed Handle_T is defined in corresponding header (as typedef).
765 set isQObject [expr [regexp "Q_OBJECT" $aHeaderContent] && [regexp "(slots|signals)\s*:" $aHeaderContent]]
766
767 # replace all IDs with prefix Handle_ by use of Handle() macro
768 if { ! $isQObject } {
769 set anUpdatedHeaderContent {}
770 set pattern_handle {\mHandle_([A-Za-z0-9_]+)}
771 foreach line $aHeaderContent {
f5f4ebd0 772 # do not touch typedefs, #include, and #if... statements
773 if { [regexp {^\s*typedef} $line] ||
774 [regexp {^\s*\#\s*include} $line] || [regexp {^\s*\#\s*if} $line] } {
d1a67b9d 775 lappend anUpdatedHeaderContent $line
776 continue
777 }
778
779 # in other preprocessor statements, skip first expression to avoid
780 # replacements in #define Handle_... and similar cases
781 set index 0
782 if { [regexp -indices {\s*#\s*[A-Za-z]+\s+[^\s]+} $line location] } {
783 set index [expr 1 + [lindex $location 1]]
784 }
785
786 # replace Handle_T by Handle(T)
787 while { [regexp -start $index -indices $pattern_handle $line location class] } {
788 set index [lindex $location 1]
789
790 set class [eval string range \$line $class]
791# puts "Found: [eval string range \$line $location]"
792
793 if { ! $theCheckMode } {
794 set anUpdateHeader true
795 ReplaceSubString line $location "Handle($class)" index
796 } else {
797 logwarn "Warning: $aHeader refers to IDs starting with \"Handle_\" which are likely"
798 logwarn " instances of OCCT Handle classes (e.g. \"$class\"); these are to be "
799 logwarn " replaced by template opencascade::handle<> or legacy macro Handle()"
800 set index -1 ;# to break outer cycle
801 break
802 }
803 }
804 lappend anUpdatedHeaderContent $line
805
806 if { $index < 0 } {
807 set anUpdatedHeaderContent $aHeaderContent
808 break
809 }
810 }
811 set aHeaderContent $anUpdatedHeaderContent
812 }
813
814 # replace NS::Handle(A) by Handle(NS::A)
815 set anUpdatedHeaderContent {}
816 set pattern_nshandle {([A-Za-z0-9_]+)\s*::\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)}
817 foreach line $aHeaderContent {
818 set index 0
819
820 while { [regexp -start $index -indices -lineanchor $pattern_nshandle $line location scope class]} {
821 set index [lindex $location 1]
822
823 set scope [eval string range \$line $scope]
824 set class [eval string range \$line $class]
825
826 if { ! $theCheckMode } {
827 set anUpdateHeader true
828 ReplaceSubString line $location "Handle(${scope}::${class})" index
829 } else {
830 logwarn "Warning in $aHeader: usage of Handle macro inside scope is incorrect: [eval string range \$line $location]"
831 set index -1 ;# to break outer cycle
832 break
833 }
834 }
835 lappend anUpdatedHeaderContent $line
836
837 if { $index < 0 } {
838 set anUpdatedHeaderContent $aHeaderContent
839 break
840 }
841 }
842 set aHeaderContent $anUpdatedHeaderContent
843
844 # remove all forward declarations of Handle classes
845 set anUpdatedHeaderContent {}
846 set aFwdHandlePattern {^\s*class\s+Handle[_\(]([A-Za-z0-9_]+)[\)]?\s*\;\s*$}
847 foreach aHeaderContentLine $aHeaderContent {
848 if {[regexp $aFwdHandlePattern $aHeaderContentLine dummy aForwardDeclHandledClass]} {
849 if {$theCheckMode} {
850 loginfo "Info: $aHeader contains statement involving forward decl of Handle_$aForwardDeclHandledClass"
851 } else {
852 # replace by forward declaration of a class or its include unless
853 # it is already declared or included
f5f4ebd0 854 if { ! [regexp "\#\\s*include\\s*\[\<\"\]\\s*(\[A-Za-z0-9_/\]*/)?$aForwardDeclHandledClass\[.\]hxx\\s*\[\>\"\]" $aHeaderContent] } {
855 if { $isQObject && "$aCurrentHeaderName" != "${aForwardDeclHandledClass}.hxx" } {
d1a67b9d 856 lappend anUpdatedHeaderContent "#include <${aForwardDeclHandledClass}.hxx>"
857 if { ! [SearchForFile $theIncPaths ${aForwardDeclHandledClass}.hxx] } {
858 loginfo "Warning: include ${aForwardDeclHandledClass}.hxx added in $aHeader, assuming it exists and defines Handle_$aForwardDeclHandledClass"
859 }
860 } elseif { ! [regexp "^\s*class\s+$aForwardDeclHandledClass\s*;" $aHeaderContent] } {
861 lappend anUpdatedHeaderContent "class $aForwardDeclHandledClass;"
862 }
863 }
864 set anUpdateHeader true
865 continue
866 }
867 }
868 lappend anUpdatedHeaderContent $aHeaderContentLine
869 }
870 set aHeaderContent $anUpdatedHeaderContent
871
872 # remove all typedefs using Handle() macro to generate typedefed name
873 set anUpdatedHeaderContent {}
874 set aTypedefHandlePattern {^\s*typedef\s+[_A-Za-z\<\>, \s]+\s+Handle\([A-Za-z0-9_]+\)\s*\;\s*$}
875 foreach aHeaderContentLine $aHeaderContent {
876 if {[regexp $aTypedefHandlePattern $aHeaderContentLine aFoundPattern]} {
877 if {$theCheckMode} {
878 loginfo "Info: $aHeader contains typedef using Handle macro to generate name: $aFoundPattern"
879 } else {
880 set anUpdateHeader true
881 continue
882 }
883 }
884 lappend anUpdatedHeaderContent $aHeaderContentLine
885 }
886 set aHeaderContent $anUpdatedHeaderContent
887
888 # remove all #include statements for files starting with "Handle_"
889 set anUpdatedHeaderContent {}
890 set anIncHandlePattern {^\s*\#\s*include\s+[\<\"]\s*(Handle[\(_][A-Za-z0-9_.]+[\)]?)\s*[\>\"]\s*$}
891 foreach aHeaderContentLine $aHeaderContent {
892 if {[regexp $anIncHandlePattern $aHeaderContentLine aFoundPattern anHxxName] &&
893 ! [SearchForFile $theIncPaths $anHxxName]} {
894 if {$theCheckMode} {
895 loginfo "Info: $aHeader includes missing header: $anHxxName"
896 } else {
897 set anUpdateHeader true
898 continue
899 }
900 }
901 lappend anUpdatedHeaderContent $aHeaderContentLine
902 }
903
904 # save result
905 if {$anUpdateHeader} {
906 SaveListToFile $aHeader $anUpdatedHeaderContent $aHeaderEOL
907 }
908 }
909}
910
911# Replaces C-style casts of Handle object to Handle to derived type
912# by call to DownCast() method
913proc ConvertCStyleHandleCast {pkpath theExtensions theCheckMode} {
914
915 # iterate by header files
916 foreach afile [glob -nocomplain -type f -directory $pkpath *.\{$theExtensions\}] {
917 set hxx [ReadFileToRawText $afile]
918
919 set change_flag 0
920
921 # replace ((Handle(A)&)b) by Handle(A)::DownCast(b)
922 set index 0
923 set pattern_refcast1 {\(\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)\)}
924 while { [regexp -start $index -indices -lineanchor $pattern_refcast1 $hxx location class var]} {
925 set index [lindex $location 1]
926
927 set class [eval string range \$hxx $class]
928 set var [eval string range \$hxx $var]
929
930 if { ! $theCheckMode } {
931 set change_flag 1
932 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index
933 } else {
934 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
935 }
936 }
937
938 # replace (Handle(A)&)b, by Handle(A)::DownCast(b),
939 # replace (Handle(A)&)b; by Handle(A)::DownCast(b);
940 # replace (Handle(A)&)b) by Handle(A)::DownCast(b))
941 set index 0
942 set pattern_refcast2 {\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)(\s*[,;\)])}
943 while { [regexp -start $index -indices -lineanchor $pattern_refcast2 $hxx location class var end]} {
944 set index [lindex $location 1]
945
946 set class [eval string range \$hxx $class]
947 set var [eval string range \$hxx $var]
948 set end [eval string range \$hxx $end]
949
950 if { ! $theCheckMode } {
951 set change_flag 1
952 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index
953 } else {
954 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
955 }
956 }
957
958 # replace (*((Handle(A)*)&b)) by Handle(A)::DownCast(b)
959 set index 0
960 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*\)}
961 while { [regexp -start $index -indices -lineanchor $pattern_ptrcast1 $hxx location start class var] } {
962 set index [lindex $location 1]
963
964 set start [eval string range \$hxx $start]
965 set class [eval string range \$hxx $class]
966 set var [eval string range \$hxx $var]
967
968 if { ! $theCheckMode } {
969 set change_flag 1
970 ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index
971 } else {
972 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
973 }
974 }
975
976 # replace *((Handle(A)*)&b) by Handle(A)::DownCast(b)
977 set index 0
978 set pattern_ptrcast2 {[*]\s*\(\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)\s*\)}
979 while { [regexp -start $index -indices -lineanchor $pattern_ptrcast2 $hxx location class var] } {
980 set index [lindex $location 1]
981
982 set class [eval string range \$hxx $class]
983 set var [eval string range \$hxx $var]
984
985 if { ! $theCheckMode } {
986 set change_flag 1
987 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index
988 } else {
989 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
990 }
991 }
992
993 # replace (*(Handle(A)*)&b) by Handle(A)::DownCast(b)
994 set index 0
995 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*\)}
996 while { [regexp -start $index -indices -lineanchor $pattern_ptrcast3 $hxx location start class var] } {
997 set index [lindex $location 1]
998
999 set start [eval string range \$hxx $start]
1000 set class [eval string range \$hxx $class]
1001 set var [eval string range \$hxx $var]
1002
1003 if { ! $theCheckMode } {
1004 set change_flag 1
1005 ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index
1006 } else {
1007 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
1008 }
1009 }
1010
1011 # replace *(Handle(A)*)&b, by Handle(A)::DownCast(b),
1012 # replace *(Handle(A)*)&b; by Handle(A)::DownCast(b);
1013 # replace *(Handle(A)*)&b) by Handle(A)::DownCast(b))
1014 set index 0
1015 set pattern_ptrcast4 {[*]\s*\(Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[*]\s*\)\s*[&]\s*([A-Za-z0-9_]+)(\s*[,;\)])}
1016 while { [regexp -start $index -indices -lineanchor $pattern_ptrcast4 $hxx location class var end] } {
1017 set index [lindex $location 1]
1018
1019 set class [eval string range \$hxx $class]
1020 set var [eval string range \$hxx $var]
1021 set end [eval string range \$hxx $end]
1022
1023 if { ! $theCheckMode } {
1024 set change_flag 1
1025 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index
1026 } else {
1027 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
1028 }
1029 }
1030
1031 # just warn if some casts to & are still there
1032 set index 0
1033 set pattern_refcast0 {\(\s*Handle\s*\(\s*([A-Za-z0-9_]+)\s*\)\s*[&]\s*\)\s*([A-Za-z0-9_]+)}
1034 while { [regexp -start $index -indices -lineanchor $pattern_refcast0 $hxx location class var] } {
1035 set index [lindex $location 1]
1036
f5f4ebd0 1037 set var [eval string range \$hxx $var]
1038 if { "$var" != "const" && "$var" != "Standard_OVERRIDE" } {
1039 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
1040 }
d1a67b9d 1041 }
1042
1043 # replace const Handle(A)& a = Handle(B)::DownCast (b); by
1044 # Handle(A) a ( Handle(B)::DownCast (b) );
1045 set index 0
1046 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*\([^;]+);}
1047 while { [regexp -start $index -indices -lineanchor $pattern_refvar $hxx location class var hexpr] } {
1048 set index [lindex $location 1]
1049
1050 set class [eval string range \$hxx $class]
1051 set var [eval string range \$hxx $var]
1052 set hexpr [eval string range \$hxx $hexpr]
1053
1054 if { ! $theCheckMode } {
1055 set change_flag 1
1056 ReplaceSubString hxx $location "Handle($class) $var ($hexpr);" index
1057 } else {
1058 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
1059 }
1060 }
1061
1062 # apply changes to the header file
1063 if { $change_flag } {
1064 SaveTextToFile $afile $hxx
1065 }
1066 }
1067}
1068
1069# Remove unnecessary forward declaration of a class if found immediately before
1070# its use in DEFINE_STANDARD_HANDLE
1071proc RemoveFwdClassForDefineStandardHandle {pkpath theCheckMode} {
1072
1073 # iterate by header files
1074 foreach afile [glob -nocomplain -type f -directory $pkpath *.?xx] {
1075
1076 # load a file
1077 if { [catch {set fd [open $afile rb]}] } {
1078 logerr "Error: cannot open $afile"
1079 continue
1080 }
1081 set hxx [read $fd]
1082 close $fd
1083
1084 set change_flag 0
1085
1086 # replace
1087 set index 0
1088 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]*}
1089 while { [regexp -start $index -indices -lineanchor $pattern_fwddef $aProcessedFileContent location fwdclass class1 class2] } {
1090 set index [lindex $location 1]
1091
1092 set fwdclass [eval string range \$aProcessedFileContent $fwdclass]
1093 set class1 [eval string range \$aProcessedFileContent $class1]
1094 set class2 [eval string range \$aProcessedFileContent $class2]
1095
1096 if { $fwdclass != $class1 } {
1097 continue
1098 }
1099
1100 if { ! $theCheckMode } {
1101 set change_flag 1
1102 ReplaceSubString aProcessedFileContent $location "DEFINE_STANDARD_HANDLE($class1, $class2)" index
1103 incr index -1
1104 } else {
1105 logwarn "Warning: $aProcessedFile contains unnecessary forward declarations of class $fwdclass"
1106 break
1107 }
1108 }
1109
1110 # apply changes to the header file
1111 if { $change_flag } {
1112 SaveTextToFile $afile $hxx
1113 }
1114 }
1115}
1116
1117# auxiliary: modifies variable text_var replacing part defined by two indices
1118# given in location by string str, and updates index_var variable to point to
1119# the end of the replaced string. Variable flag_var is set to 1.
1120proc ReplaceSubString {theSource theLocation theSubstitute theEndIndex} {
1121
1122 upvar $theSource aSource
1123 upvar $theEndIndex anEndIndex
1124
1125 set aStartIndex [lindex $theLocation 0]
1126 set anEndIndex [lindex $theLocation 1]
1127 set aSource [string replace "$aSource" $aStartIndex $anEndIndex "$theSubstitute"]
1128 set anEndIndex [expr $aStartIndex + [string length $theSubstitute]]
1129}
1130
1131# Save theFileContent some text to theFilePath file
1132proc SaveTextToFile {theFilePath theFileContent} {
1133 if { [catch {set aFile [open ${theFilePath} w];} aReason] } {
1134 logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason"
1135 return
1136 }
1137
1138 fconfigure $aFile -translation binary
1139 puts -nonewline $aFile "$theFileContent"
1140 close $aFile
1141
1142 loginfo "File $theFilePath modified"
1143}
1144
1145# read content from theFilePath to list, theFileContent is a raw content of the file
1146proc ReadFileToList {theFilePath theFileContent theFileEOL} {
1147 upvar $theFileContent aFileContent
1148 upvar $theFileEOL aFileEOL
1149
1150 if {"$theFilePath" == "" || ![file exists $theFilePath]} {
1151 return
1152 }
1153
1154 if { [catch {set aFile [open ${theFilePath} r]} aReason] } {
1155 logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason"
1156 return
1157 }
1158
1159 fconfigure $aFile -translation binary
1160 set aFileContent [read $aFile]
1161 close $aFile
1162
155408bf 1163 # detect DOS end-of-lines
1164 if { [regexp "\r\n" $aFileContent] } {
d1a67b9d 1165 set aFileEOL "\r\n"
155408bf 1166 set aList [split [regsub -all "\r\n" $aFileContent "\n"] "\r\n"]
1167 } else {
1168 # standard UNIX end-of-lines
d1a67b9d 1169 set aFileEOL "\n"
155408bf 1170 set aList [split $aFileContent "\n"]
d1a67b9d 1171 }
1172
d1a67b9d 1173 return $aList
1174}
1175
1176# read content from theFilePath to raw text (with unix eol)
1177proc ReadFileToRawText {theFilePath} {
1178 if {"$theFilePath" == "" || ![file exists $theFilePath]} {
1179 return
1180 }
1181
1182 if { [catch {set aFile [open ${theFilePath} r]} aReason] } {
1183 logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason"
1184 return
1185 }
1186
1187 fconfigure $aFile -translation binary
1188 set aFileContent [read $aFile]
1189 close $aFile
1190
1191 set aFileEOL "\r"
1192 if [regexp "\r\n" $aFileContent] {
1193 set aFileEOL "\r\n"
1194 } elseif [regexp "\n" $aFileContent] {
1195 set aFileEOL "\n"
1196 }
1197
1198 # convert to unix eol
1199 if {"$aFileEOL" != "\n"} {
1200 regsub -all {$aFileEOL} $aFileContent "\n" aFileContent
1201 }
1202
1203 return $aFileContent
1204}
1205
1206# auxiliary: saves content of "theData" list to "theFilePath"
1207proc SaveListToFile {theFilePath theData {theEOL "auto"}} {
1208 set anUsedEol $theEOL
1209
1210 if {"$anUsedEol" == ""} {
1211 set anUsedEol "auto"
1212 }
1213
1214 # if the file exists and "eol choice" is "auto", detect the file eol
1215 if {$anUsedEol == "auto" && [file exists $theFilePath]} {
1216 if { [catch {set aFile [open ${theFilePath} r]} aReason] } {
1217 logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason"
1218 } else {
1219 fconfigure $aFile -translation binary
1220 set aFileContent [read $aFile]
1221 close $aFile
1222
1223 set anUsedEol "\r"
1224 if [regexp "\r\n" $aFileContent] {
1225 set anUsedEol "\r\n"
1226 } elseif [regexp "\n" $aFileContent] {
1227 set anUsedEol "\n"
1228 }
1229 }
1230 }
1231
1232 # write
1233 if { [catch {set aFile [open ${theFilePath} w];} aReason] } {
1234 logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason"
1235 return
1236 }
1237
1238 fconfigure $aFile -translation binary
1239 puts -nonewline $aFile [join $theData $anUsedEol]
1240 close $aFile
f5f4ebd0 1241
1242 loginfo "File $theFilePath modified"
d1a67b9d 1243}
1244
1245# collect all subdirs of theBaseDir
1246proc CollectDirStructure {theBaseDir} {
1247 set aDirs [glob -nocomplain -directory $theBaseDir -type d *]
1248
1249 set aSubDirs {}
1250 foreach aDir $aDirs {
1251 foreach aSubDir [CollectDirStructure $aDir] {
1252 lappend aSubDirs $aSubDir
1253 }
1254 }
1255
1256 foreach aSubDir $aSubDirs {
1257 lappend aDirs $aSubDir
1258 }
1259
1260 return $aDirs
1261}
1262
1263# check existence of theFileName file in several folders (theIncPaths)
1264proc SearchForFile {theIncPaths theFileName} {
1265 foreach aPath $theIncPaths {
1266 if {[file exists "${aPath}/${theFileName}"]} {
1267 return true
1268 }
1269 }
1270
1271 return false
1272}
1273
1274# auxiliary: parse the string to comment and not comment parts
1275# variable "_cmnt" should be created before using the operation, it will save comment part of line
1276# variable "_isMulti" should be created before the loop, equal to "false" if first line in the loop is not multi-comment line
1277proc _check_line { line } {
1278 upvar _isMulti _isMulti
1279 upvar _cmnt _cmnt
1280
1281 set string_length [string length $line]
1282 set c_b $string_length
1283 set mc_b $string_length
1284 set mc_e $string_length
1285 regexp -indices {//} $line c_b
1286 regexp -indices {/\*} $line mc_b
1287 regexp -indices {\*/} $line mc_e
1288 if {!${_isMulti}} {
1289 if {[lindex $c_b 0] < [lindex $mc_b 0] && [lindex $c_b 0] < [lindex $mc_e 0]} {
1290 set notComment_c [string range $line 0 [expr [lindex $c_b 0]-1]]
1291 set Comment_c [string range $line [lindex $c_b 0] end]
1292 set _cmnt $_cmnt$Comment_c
1293 return $notComment_c
1294 } elseif {[lindex $mc_b 0] < [lindex $c_b 0] && [lindex $mc_b 0] < [lindex $mc_e 0]} {
1295 set _isMulti true
1296 set _cmnt "${_cmnt}/*"
1297 set notComment_mc [string range $line 0 [expr [lindex $mc_b 0]-1]]
1298 set Comment_mc [string range $line [expr [lindex $mc_b 1]+1] end]
1299 return [_check_line "${notComment_mc}[_check_line ${Comment_mc}]"]
1300 } elseif {[lindex $mc_e 0] < [lindex $c_b 0] && [lindex $mc_e 0] < [lindex $mc_b 0]} {
1301 set notComment_mc [string range $line [expr [lindex $mc_e 1]+1] end]
1302 set Comment_mc [string range $line 0 [expr [lindex $mc_e 0]-1]]
1303 set _cmnt "${_cmnt}${Comment_mc}*/"
1304 set chk [_check_line ${notComment_mc}]
1305 set _isMulti true
1306 return $chk
1307 }
1308 } else {
1309 if {[lindex $mc_e 0] < [lindex $mc_b 0]} {
1310 set _isMulti false
1311 set Comment_mc [string range $line 0 [lindex $mc_e 1]]
1312 set notComment_mc [string range $line [expr [lindex $mc_e 1]+1] end]
1313 set _cmnt $_cmnt$Comment_mc
1314 return [_check_line $notComment_mc]
1315 } elseif {[lindex $mc_b 0] < [lindex $mc_e 0] } {
1316 set notComment_mc [string range $line 0 [expr [lindex $mc_b 0]-1]]
1317 set Comment_mc [string range $line [expr [lindex $mc_b 1]+1] end]
1318 set _cmnt "${_cmnt}/*"
1319 set chk [_check_line "${notComment_mc}[_check_line ${Comment_mc}]"]
1320 set _isMulti false
1321 return $chk
1322 } else {
1323 set _cmnt $_cmnt$line
1324 return ""
1325 }
1326 }
1327 return $line
1328}
1329
1330# Create Tk-based logger which allows convenient consulting the upgrade process.
1331proc _create_logger {} {
1332 if { [catch {winfo exists .h}] } {
1333 logerr "Error: Tk commands are not available, cannot create UI!"
1334 return
1335 }
1336
1337 if { ![winfo exists .h ] } {
1338 toplevel .h
1339 wm title .h "Conversion log"
1340 wm geometry .h +320+200
1341 wm resizable .h 0 0
1342
1343 text .h.t -yscrollcommand {.h.sbar set}
1344 scrollbar .h.sbar -orient vertical -command {.h.t yview}
1345
1346 pack .h.sbar -side right -fill y
1347 pack .h.t
1348 }
1349}
1350
1351set LogFilePath ""
1352
1353# Puts the passed string into Tk-based logger highlighting it with the
1354# given color for better view. If no logger exists (-wlog option was not
1355# activated), the standard output is used.
1356proc _logcommon {theLogMessage {theMessageColor ""}} {
1357 global LogFilePath
1358
1359 if {"$LogFilePath" != ""} {
1360 if { ! [catch {set aLogFile [open ${LogFilePath} a];} aReason] } {
1361 set t [clock milliseconds]
1362 set aTimeAndMessage [format "\[%s\] %s" \
1363 [clock format [expr {$t / 1000}] -format %T] \
1364 $theLogMessage \
1365 ]
1366
1367
1368 puts $aLogFile $aTimeAndMessage
1369 close $aLogFile
1370 } else {
1371 logerr "Error: cannot open $LogFilePath log file due to $aReason"
1372 }
1373 }
1374
1375 if { ! [catch {winfo exists .h} res] && $res } {
1376 .h.t insert end "$theLogMessage\n"
1377
1378 if {$theLogMessage != ""} {
1379 # We use the current number of lines to generate unique tag in the text
1380 set aLineNb [lindex [split [.h.t index "end - 1 line"] "."] 0]
1381
1382 .h.t tag add my_tag_$aLineNb end-2l end-1l
1383 .h.t tag configure my_tag_$aLineNb -background $theMessageColor
1384 }
1385
1386 update
1387 } else {
1388 puts $theLogMessage
1389 }
1390}
1391
1392# Puts information message to logger.
1393proc loginfo {a} {
1394 _logcommon $a
1395}
1396
1397# Puts warning message to logger.
1398proc logwarn {a} {
1399 _logcommon $a "pink"
1400}
1401
1402# Puts error message to logger.
1403proc logerr {a} {
1404 _logcommon $a "red"
1405}