1 # This script provides commands for upgrade of OCCT and software based on it
2 # to a newer version of OCCT (7.0)
5 # source code for upgrading
6 set ArgName(HelpInfo) "h"
8 set ArgName(SourceCode) "src"
9 set ArgName(IncPath) "inc"
11 set ArgName(IncExtension) "incext"
12 set ArgName(SrcExtension) "srcext"
14 set ArgName(RTTI) "rtti"
16 set ArgName(CStyleCastHandle) "handlecast"
17 set ArgName(All) "all"
19 set ArgName(Handle) "handle"
20 set ArgName(TCollection) "tcollection"
22 set ArgName(CompatibleMode) "compat"
24 set ArgName(Recurse) "recurse"
25 set ArgName(Rename) "rename"
27 set ArgName(CheckOnly) "check"
28 set ArgName(WLog) "wlog"
29 set ArgName(Log) "log"
31 proc HelpInformation {} {
33 global DataSectionName
35 loginfo "Tool for upgrade of application code from older versions of OCCT."
37 loginfo "Required parameter:"
38 loginfo " -$ArgName(SourceCode)=<path> - path to sources to upgrade"
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"
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"
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"
63 proc ParseArgs {theArgValues theArgs {theRemoveFromArgs "false"}} {
64 upvar $theArgValues anArgValues
67 global DataSectionName
70 set anArgValues(HelpInfo) [SeekArg $ArgName(HelpInfo) theArgs "false" $theRemoveFromArgs]
72 # sources that will be upgraded
73 set anArgValues(SourceCode) [SeekArg $ArgName(SourceCode) theArgs "" $theRemoveFromArgs]
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]
79 set anArgValues(IncPath) [SeekArg $ArgName(IncPath) theArgs "$anArgValues(SourceCode)" $theRemoveFromArgs]
81 set anArgValues(RTTI) [SeekArg $ArgName(RTTI) theArgs "false" $theRemoveFromArgs]
82 set anArgValues(CStyleCastHandle) [SeekArg $ArgName(CStyleCastHandle) theArgs "false" $theRemoveFromArgs]
84 set anArgValues(Handle) [SeekArg $ArgName(Handle) theArgs "false" $theRemoveFromArgs]
85 set anArgValues(TCollection) [SeekArg $ArgName(TCollection) theArgs "false" $theRemoveFromArgs]
87 set anArgValues(Rename) [SeekArg $ArgName(Rename) theArgs "false" $theRemoveFromArgs]
89 set aHasAgentArgs [expr {$anArgValues(RTTI) || $anArgValues(CStyleCastHandle) || \
90 $anArgValues(Handle) || $anArgValues(TCollection)} || \
93 set anArgValues(All) [SeekArg $ArgName(All) theArgs [expr {!$aHasAgentArgs}] $theRemoveFromArgs]
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]
100 set anArgValues(Log) [SeekArg $ArgName(Log) theArgs "" $theRemoveFromArgs]
105 proc SeekArg {theSoughtArgName theArgs {theDefaultArgValue ""} {theRemoveFromArgs false}} {
106 upvar ${theArgs} anArgs
108 set aBooleanValue [string is boolean -strict $theDefaultArgValue]
113 foreach anArg $anArgs {
116 if {[regexp -- "-${theSoughtArgName}\=\(.\*\)" $anArg dummy anArgValue]} {
117 set anArgValue [regsub -all {\\} $anArgValue {/}]
118 if {$theRemoveFromArgs} {
119 set anArgs [lreplace $anArgs $anArgsIndex $anArgsIndex]
122 if {"$anArgValue" != ""} {
123 lappend anArgValues $anArgValue
125 logwarn "'-${theSoughtArgName}' is skipped because it has empty value"
127 } elseif [string match "-${theSoughtArgName}" $anArg] {
128 if {$theRemoveFromArgs} {
129 set anArgs [lreplace $anArgs $anArgsIndex $anArgsIndex]
131 # skip non-boolean empty argument; do not break the foreach loop
132 if {$aBooleanValue} {
133 lappend anArgValues "true"
136 logwarn "'-${theSoughtArgName}' is skipped because it has empty value"
141 # return boolean value as string
142 if {$aBooleanValue} {
143 if {[llength $anArgValues] > 0} {
144 return [lindex $anArgValues 0]
146 return $theDefaultArgValue
150 if {[llength $anArgValues] == 0 && "$theDefaultArgValue" != ""} {
151 lappend anArgValues $theDefaultArgValue
157 # section names in the data file
158 set DataSectionName(TCollection) "tcollection"
159 set DataSectionName(Rename) "rename"
161 proc DataFileName {} {
162 return [file join [file dirname [info script]] upgrade.dat]
165 proc IsDataFileExist {} {
166 return [file exists [DataFileName]]
169 proc ReadFromDataFile {theSectionName} {
170 if {![file exists [DataFileName]]} {
174 set aFileContent [ReadFileToList [DataFileName] aFileRawContent aDataEOL]
176 set aSectionValueList {}
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"} {
185 } elseif {$anIsSection == true} {
186 set anIsSection false
191 if {$anIsSection == true} {
192 set aTrimmedLine [string trimright $aLine]
193 if {"$aTrimmedLine" != ""} {
194 lappend aSectionValueList $aTrimmedLine
199 return $aSectionValueList
202 proc SaveToDataFile {theSectionName theSectionContent} {
203 if {![file exists [DataFileName]]} {
207 set aFileContent [ReadFileToList [DataFileName] aFileRawContent aDataEOL]
212 set anIsSection false
213 set anIsSectionBefore true
214 set anIsSectionAfter false
216 set aSectionPattern {^ *\[ *([A-Za-z0-9_\.]*) *\]+}
217 foreach aLine $aFileContent {
218 if {$anIsSectionBefore} {
219 lappend aLinesBefore $aLine
222 if {[regexp -- $aSectionPattern $aLine dummy aSectionName]} {
223 if {"$aSectionName" == "$theSectionName"} {
224 set anIsSectionBefore false
226 } elseif {$anIsSection == true} {
227 set anIsSection false
228 set anIsSectionAfter true
232 if {$anIsSection == true} {
236 if {$anIsSectionAfter} {
237 lappend aLinesAfter $aLine
242 SaveListToFile [DataFileName] [list {*}$aLinesBefore {*}$theSectionContent {*}$aLinesAfter] $aDataEOL
245 # Main tool, accepts path to location of source tree to be upgraded.
246 proc upgrade {args} {
250 global DataSectionName
253 set anUnparsedArgs [ParseArgs anArgValues $theArgs "true"]
255 if {"$anUnparsedArgs" != ""} {
256 logerr "undefined arguments: $anUnparsedArgs"
257 loginfo "use -$ArgName(HelpInfo) to show all the arguments"
261 if {$anArgValues(HelpInfo) || [llength $anArgValues(SourceCode)] == 0} {
266 if {"$anArgValues(Log)" != ""} {
267 set LogFilePath $anArgValues(Log)
269 # clean file before writing
270 if {[file exists "$LogFilePath"]} {
271 set fd [open "$LogFilePath" r+]
277 if {$anArgValues(WLog)} {
281 # collect src directory structure (all subdirs)
283 foreach aSrcDir $anArgValues(SourceCode) {
284 lappend anIncPaths $aSrcDir
285 foreach aSubSrcDir [CollectDirStructure $aSrcDir] {
286 lappend anIncPaths $aSubSrcDir
290 foreach anIncDir $anArgValues(IncPath) {
291 lappend anIncPaths $anIncDir
292 foreach aSubIncDir [CollectDirStructure $anIncDir] {
293 lappend anIncPaths $aSubIncDir
297 set anIncPaths [lsort -unique -dictionary $anIncPaths]
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]
310 if {[llength [array names aNewNames]] == 0} {
313 logwarn "renaming skipped. there is no class names to rename"
314 logwarn "see the content of [DataFileName] file, $DataSectionName(Rename) section"
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)"]
324 set aProcNameWithArgs [format "$aProcNameWithArgs -%s" "$ArgName($anArgName)=$anArgValues($anArgName)"]
328 loginfo "$aProcNameWithArgs"
330 # merge all processed extensions
331 set anExtensions "$anArgValues(SrcExtension),$anArgValues(IncExtension)"
333 set aSourceCodePaths $anArgValues(SourceCode)
334 while {[llength $aSourceCodePaths]} {
335 set aSourceCodePaths [lassign $aSourceCodePaths aProcessedPath]
337 loginfo "Processing: $aProcessedPath"
339 if {$anArgValues(All) || $anArgValues(RTTI)} {
340 ConvertRtti $aProcessedPath \
342 $anArgValues(CheckOnly) \
343 $anArgValues(CompatibleMode) \
344 $anArgValues(IncExtension) \
345 $anArgValues(SrcExtension)
348 if {$anArgValues(All) || $anArgValues(Handle)} {
349 ConvertHandle $aProcessedPath $anIncPaths $anArgValues(CheckOnly) $anExtensions
352 if {$anArgValues(All) || $anArgValues(TCollection)} {
353 ConvertTColFwd $aProcessedPath $anArgValues(IncExtension)
356 if {$anArgValues(All) || $anArgValues(CStyleCastHandle)} {
357 ConvertCStyleHandleCast $aProcessedPath $anExtensions $anArgValues(CheckOnly)
360 if {$anArgValues(All) || $anArgValues(Rename)} {
362 Rename $aProcessedPath $anExtensions aNewNames $anArgValues(CheckOnly)
367 if {$anArgValues(Recurse)} {
368 lappend aSourceCodePaths {*}[glob -nocomplain -directory $aProcessedPath -type d *]
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
378 set aNames [array names aNewNames]
380 foreach aFile [glob -nocomplain -type f -directory $thePath *.{$theExtensions}] {
381 # loginfo "$aFile processing"
382 set aFileContent [ReadFileToRawText $aFile]
384 set aHasChanges false
385 foreach aName $aNames {
387 set aClassNameTmpl "\\m$aName\\M"
388 while { [regexp -start $anIndexInRow -indices -lineanchor $aClassNameTmpl $aFileContent aFoundClassNameLoc] } {
389 set anIndexInRow [lindex $aFoundClassNameLoc 1]
392 logwarn "Warning: $aFile contains $aName"
396 ReplaceSubString aFileContent $aFoundClassNameLoc "$aNewNames($aName)" anIndexInRow
403 SaveTextToFile $aFile $aFileContent
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
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
419 if {! [file exists $thePackagePath]} {
420 logerr "Error: $thePackagePath does not exist"
424 # read the list of already converted TCollection classes
425 if [IsDataFileExist] {
426 set aConvertedTColClasses [ReadFromDataFile $DataSectionName(TCollection)]
428 logerr "[DataFileName] file of upgrade process does not exist"
432 # pattern that will be used
433 set aForwardDeclPattern {^ *class *([A-Za-z0-9_/\.]+) *;}
435 set aTargetPaths ${thePackagePath}
436 while {[llength $aTargetPaths]} {
437 set aTargetPaths [lassign $aTargetPaths aProcessedPath]
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}]
446 foreach aHeader $aProcessedHeaders {
447 set aHeaderLineIndex -1
448 set aHeaderContentUpdated false
450 # read the content of the header file
451 set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL]
453 # remove _isMulti variable that used in _check_line
456 foreach aHeaderContentLine $aHeaderContent {
457 incr aHeaderLineIndex
459 # remove _cmnt variable that used in _check_line
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]
472 if {$aHeaderContentUpdated} {
473 loginfo "$aHeader updated"
474 SaveListToFile $aHeader $aHeaderContent $aHeaderEOL
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)
484 proc 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 } {
492 # try to find source file with the same name but source-type extension
494 set filename [file rootname $hxxfile]
495 foreach ext [split $theSourceExtensions ,] {
496 # puts "Checking ${filename}.$ext"
497 if { ! [file readable ${filename}.$ext] } { continue }
499 # check the file content
500 set aFileContent [ReadFileToList ${filename}.$ext aFileRawContent aEOL]
502 # try to find existing macro IMPLEMENT_STANDARD_RTTIEXT and check that
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
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"
517 # inject a new macro before the first non-empty, non-comment, and
518 # non-preprocessor line
519 set aNewFileContent {}
522 foreach line $aFileContent {
524 # add macro before first non-empty line after #includes
525 if { [regexp {^\s*$} $line] } {
526 } elseif { [regexp {^\s*\#\s*include} $line] } {
528 } elseif { $inc_found } {
530 lappend aNewFileContent "IMPLEMENT_STANDARD_RTTIEXT($class,$base)"
531 if { ! [regexp "^IMPLEMENT_" $line] } {
532 lappend aNewFileContent ""
536 lappend aNewFileContent $line
539 lappend aNewFileContent "IMPLEMENT_STANDARD_RTTIEXT($class,$base)"
541 SaveListToFile ${filename}.$ext $aNewFileContent $aEOL
546 logwarn "Warning in ${hxxfile}: cannot find corresponding source file,"
547 logwarn " will use inline version of DEFINE_STANDARD_RTTI"
551 # Parse source files and:
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
559 # If theCompatibleMode is false, in addition:
560 # - removes macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*();
561 proc ConvertRtti {theProcessedPath theIncPaths theCheckMode theCompatibleMode \
562 theHeaderExtensions theSourceExtensions} {
564 # iterate by header and source files
565 foreach aProcessedFile [glob -nocomplain -type f -directory $theProcessedPath *.{$theHeaderExtensions,$theSourceExtensions}] {
566 set aProcessedFileName [file tail $aProcessedFile]
568 set aProcessedFileContent [ReadFileToRawText $aProcessedFile]
570 # find all declarations of classes with public base in this header file;
571 # the result is stored in array inherits(class)
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]
578 set class [eval string range \$aProcessedFileContent $class]
579 set base [eval string range \$aProcessedFileContent $base]
581 if { [info exists inherits($class)] } {
582 set inherits($class,multiple) "found multiple declarations of class $class"
584 if { [lindex $comma 0] <= [lindex $comma 1] } {
585 set inherits($class,multiple) "class $class uses multiple inheritance"
587 set inherits($class) $base
593 # find all instances of DEFINE_STANDARD_RTTI with single or two arguments
595 set pattern_rtti {^(\s*DEFINE_STANDARD_RTTI)([_A-Z]+)?\s*\(\s*([A-Za-z_0-9,\s]+)\s*\)}
596 while { [regexp -start $index -indices -lineanchor $pattern_rtti \
597 $aProcessedFileContent location start suffix clist] } {
598 set index [lindex $location 1]
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] ,]
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!"
613 ReplaceSubString aProcessedFileContent $location \
614 "${start}EXT($class,$inherits($class))" index
617 logwarn "Error in $aProcessedFile: Macro DEFINE_STANDARD_RTTI used for class $class whose declaration is not found in this file, cannot fix"
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"
624 } elseif { $base != $inherits($class) && ! [info exists inherits($class,multiple)] } {
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)"
627 # convert intermediate version of macro DEFINE_STANDARD_RTTI
628 # with two arguments to either _INLINE or EXT variant
629 if { ! $theCheckMode && "$suffix" == "" } {
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
641 # replace includes of Standard_DefineHandle.hxx by Standard_Type.hxx
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 } {
648 # ReplaceSubString aProcessedFileContent $location "\#include <Standard_Type.hxx>" index
651 # logwarn "Warning: $aProcessedFile contains obsolete forward declarations of Handle classes"
656 # remove macros IMPLEMENT_DOWNCAST() and IMPLEMENT_STANDARD_*();
657 if { ! $theCompatibleMode } {
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*;?}
661 while { [regexp -start $index -indices -lineanchor $pattern_implement $aProcessedFileContent location macro] } {
662 set index [lindex $location 1]
663 # macro IMPLEMENT_STANDARD_RTTIEXT is retained
664 if { [eval string range \$aProcessedFileContent $macro] == "STANDARD_RTTIEXT" } {
667 if { ! $theCheckMode } {
669 ReplaceSubString aProcessedFileContent $location $first_newline index
670 # set first_newline ""
673 logwarn "Warning: $aProcessedFile contains deprecated macros IMPLEMENT_*"
679 # find all uses of macro STANDARD_TYPE and method DownCast and ensure that
680 # argument class is explicitly included
681 set pattern_incbeg {\s*#\s*include\s*[\"<]\s*([A-Za-z0-9_/]*/)?}
682 set pattern_incend {[.][a-zA-Z]+\s*[\">]}
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
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
705 if { [llength $addtype] > 0 } {
706 if { ! $theCheckMode } {
708 foreach type $addtype {
709 if { "$aProcessedFileName" != "$type.hxx" } {
710 append addinc "\n#include <$type.hxx>"
713 if { [regexp -indices ".*\n${pattern_incbeg}\[A-Za-z0-9_/\]+${pattern_incend}" $aProcessedFileContent location] } {
715 ReplaceSubString aProcessedFileContent $location "[eval string range \$aProcessedFileContent $location]$addinc" index
717 logerr "Error: $aProcessedFile: Cannot find #include statement to add more includes..."
720 logwarn "Warning: $aProcessedFile: The following class names are used as arguments of STANDARD_TYPE"
721 logwarn " macro, but not included directly: $addtype"
726 # apply changes to the header file
727 if { $change_flag } {
728 SaveTextToFile $aProcessedFile $aProcessedFileContent
733 # replace all forward declarations of "class Handle(...)" with fwd of "class ..."
734 proc ConvertHandle {theTargetPath theIncPaths theCheckMode theExtensions} {
736 # iterate by header files
737 foreach aHeader [glob -nocomplain -type f -directory $theTargetPath *.{$theExtensions}] {
738 set aCurrentHeaderName [file tail $aHeader]
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"} {
746 # read the content of the header
747 if { [catch {set fd [open $aHeader rb]}] } {
748 logerr "Error: cannot open $aHeader"
753 set aHeaderContent [ReadFileToList $aHeader aHeaderRawContent aHeaderEOL]
755 set anUpdateHeader false
757 # if file contains "slots:" or "signals:", assume it defines some QObject
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]]
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 {
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] } {
775 lappend anUpdatedHeaderContent $line
779 # in other preprocessor statements, skip first expression to avoid
780 # replacements in #define Handle_... and similar cases
782 if { [regexp -indices {\s*#\s*[A-Za-z]+\s+[^\s]+} $line location] } {
783 set index [expr 1 + [lindex $location 1]]
786 # replace Handle_T by Handle(T)
787 while { [regexp -start $index -indices $pattern_handle $line location class] } {
788 set index [lindex $location 1]
790 set class [eval string range \$line $class]
791 # puts "Found: [eval string range \$line $location]"
793 if { ! $theCheckMode } {
794 set anUpdateHeader true
795 ReplaceSubString line $location "Handle($class)" index
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
804 lappend anUpdatedHeaderContent $line
807 set anUpdatedHeaderContent $aHeaderContent
811 set aHeaderContent $anUpdatedHeaderContent
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 {
820 while { [regexp -start $index -indices -lineanchor $pattern_nshandle $line location scope class]} {
821 set index [lindex $location 1]
823 set scope [eval string range \$line $scope]
824 set class [eval string range \$line $class]
826 if { ! $theCheckMode } {
827 set anUpdateHeader true
828 ReplaceSubString line $location "Handle(${scope}::${class})" index
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
835 lappend anUpdatedHeaderContent $line
838 set anUpdatedHeaderContent $aHeaderContent
842 set aHeaderContent $anUpdatedHeaderContent
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]} {
850 loginfo "Info: $aHeader contains statement involving forward decl of Handle_$aForwardDeclHandledClass"
852 # replace by forward declaration of a class or its include unless
853 # it is already declared or included
854 if { ! [regexp "\#\\s*include\\s*\[\<\"\]\\s*(\[A-Za-z0-9_/\]*/)?$aForwardDeclHandledClass\[.\]hxx\\s*\[\>\"\]" $aHeaderContent] } {
855 if { $isQObject && "$aCurrentHeaderName" != "${aForwardDeclHandledClass}.hxx" } {
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"
860 } elseif { ! [regexp "^\s*class\s+$aForwardDeclHandledClass\s*;" $aHeaderContent] } {
861 lappend anUpdatedHeaderContent "class $aForwardDeclHandledClass;"
864 set anUpdateHeader true
868 lappend anUpdatedHeaderContent $aHeaderContentLine
870 set aHeaderContent $anUpdatedHeaderContent
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]} {
878 loginfo "Info: $aHeader contains typedef using Handle macro to generate name: $aFoundPattern"
880 set anUpdateHeader true
884 lappend anUpdatedHeaderContent $aHeaderContentLine
886 set aHeaderContent $anUpdatedHeaderContent
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]} {
895 loginfo "Info: $aHeader includes missing header: $anHxxName"
897 set anUpdateHeader true
901 lappend anUpdatedHeaderContent $aHeaderContentLine
905 if {$anUpdateHeader} {
906 SaveListToFile $aHeader $anUpdatedHeaderContent $aHeaderEOL
911 # Replaces C-style casts of Handle object to Handle to derived type
912 # by call to DownCast() method
913 proc ConvertCStyleHandleCast {pkpath theExtensions theCheckMode} {
915 # iterate by header files
916 foreach afile [glob -nocomplain -type f -directory $pkpath *.\{$theExtensions\}] {
917 set hxx [ReadFileToRawText $afile]
921 # replace ((Handle(A)&)b) by Handle(A)::DownCast(b)
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]
927 set class [eval string range \$hxx $class]
928 set var [eval string range \$hxx $var]
930 if { ! $theCheckMode } {
932 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index
934 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
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))
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]
946 set class [eval string range \$hxx $class]
947 set var [eval string range \$hxx $var]
948 set end [eval string range \$hxx $end]
950 if { ! $theCheckMode } {
952 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index
954 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
958 # replace (*((Handle(A)*)&b)) by Handle(A)::DownCast(b)
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]
964 set start [eval string range \$hxx $start]
965 set class [eval string range \$hxx $class]
966 set var [eval string range \$hxx $var]
968 if { ! $theCheckMode } {
970 ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index
972 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
976 # replace *((Handle(A)*)&b) by Handle(A)::DownCast(b)
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]
982 set class [eval string range \$hxx $class]
983 set var [eval string range \$hxx $var]
985 if { ! $theCheckMode } {
987 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)" index
989 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
993 # replace (*(Handle(A)*)&b) by Handle(A)::DownCast(b)
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]
999 set start [eval string range \$hxx $start]
1000 set class [eval string range \$hxx $class]
1001 set var [eval string range \$hxx $var]
1003 if { ! $theCheckMode } {
1005 ReplaceSubString hxx $location "${start}Handle($class)::DownCast ($var)" index
1007 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
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))
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]
1019 set class [eval string range \$hxx $class]
1020 set var [eval string range \$hxx $var]
1021 set end [eval string range \$hxx $end]
1023 if { ! $theCheckMode } {
1025 ReplaceSubString hxx $location "Handle($class)::DownCast ($var)$end" index
1027 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
1031 # just warn if some casts to & are still there
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]
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]"
1043 # replace const Handle(A)& a = Handle(B)::DownCast (b); by
1044 # Handle(A) a ( Handle(B)::DownCast (b) );
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]
1050 set class [eval string range \$hxx $class]
1051 set var [eval string range \$hxx $var]
1052 set hexpr [eval string range \$hxx $hexpr]
1054 if { ! $theCheckMode } {
1056 ReplaceSubString hxx $location "Handle($class) $var ($hexpr);" index
1058 logwarn "Warning in $afile: C-style cast: [eval string range \$hxx $location]"
1062 # apply changes to the header file
1063 if { $change_flag } {
1064 SaveTextToFile $afile $hxx
1069 # Remove unnecessary forward declaration of a class if found immediately before
1070 # its use in DEFINE_STANDARD_HANDLE
1071 proc RemoveFwdClassForDefineStandardHandle {pkpath theCheckMode} {
1073 # iterate by header files
1074 foreach afile [glob -nocomplain -type f -directory $pkpath *.?xx] {
1077 if { [catch {set fd [open $afile rb]}] } {
1078 logerr "Error: cannot open $afile"
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]
1092 set fwdclass [eval string range \$aProcessedFileContent $fwdclass]
1093 set class1 [eval string range \$aProcessedFileContent $class1]
1094 set class2 [eval string range \$aProcessedFileContent $class2]
1096 if { $fwdclass != $class1 } {
1100 if { ! $theCheckMode } {
1102 ReplaceSubString aProcessedFileContent $location "DEFINE_STANDARD_HANDLE($class1, $class2)" index
1105 logwarn "Warning: $aProcessedFile contains unnecessary forward declarations of class $fwdclass"
1110 # apply changes to the header file
1111 if { $change_flag } {
1112 SaveTextToFile $afile $hxx
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.
1120 proc ReplaceSubString {theSource theLocation theSubstitute theEndIndex} {
1122 upvar $theSource aSource
1123 upvar $theEndIndex anEndIndex
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]]
1131 # Save theFileContent some text to theFilePath file
1132 proc SaveTextToFile {theFilePath theFileContent} {
1133 if { [catch {set aFile [open ${theFilePath} w];} aReason] } {
1134 logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason"
1138 fconfigure $aFile -translation binary
1139 puts -nonewline $aFile "$theFileContent"
1142 loginfo "File $theFilePath modified"
1145 # read content from theFilePath to list, theFileContent is a raw content of the file
1146 proc ReadFileToList {theFilePath theFileContent theFileEOL} {
1147 upvar $theFileContent aFileContent
1148 upvar $theFileEOL aFileEOL
1150 if {"$theFilePath" == "" || ![file exists $theFilePath]} {
1154 if { [catch {set aFile [open ${theFilePath} r]} aReason] } {
1155 logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason"
1159 fconfigure $aFile -translation binary
1160 set aFileContent [read $aFile]
1163 # detect DOS end-of-lines
1164 if { [regexp "\r\n" $aFileContent] } {
1166 set aList [split [regsub -all "\r\n" $aFileContent "\n"] "\r\n"]
1168 # standard UNIX end-of-lines
1170 set aList [split $aFileContent "\n"]
1176 # read content from theFilePath to raw text (with unix eol)
1177 proc ReadFileToRawText {theFilePath} {
1178 if {"$theFilePath" == "" || ![file exists $theFilePath]} {
1182 if { [catch {set aFile [open ${theFilePath} r]} aReason] } {
1183 logerr "Error: cannot open file \"${theFilePath}\" for reading: $aReason"
1187 fconfigure $aFile -translation binary
1188 set aFileContent [read $aFile]
1192 if [regexp "\r\n" $aFileContent] {
1194 } elseif [regexp "\n" $aFileContent] {
1198 # convert to unix eol
1199 if {"$aFileEOL" != "\n"} {
1200 regsub -all {$aFileEOL} $aFileContent "\n" aFileContent
1203 return $aFileContent
1206 # auxiliary: saves content of "theData" list to "theFilePath"
1207 proc SaveListToFile {theFilePath theData {theEOL "auto"}} {
1208 set anUsedEol $theEOL
1210 if {"$anUsedEol" == ""} {
1211 set anUsedEol "auto"
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"
1219 fconfigure $aFile -translation binary
1220 set aFileContent [read $aFile]
1224 if [regexp "\r\n" $aFileContent] {
1225 set anUsedEol "\r\n"
1226 } elseif [regexp "\n" $aFileContent] {
1233 if { [catch {set aFile [open ${theFilePath} w];} aReason] } {
1234 logerr "Error: cannot open file \"${theFilePath}\" for writing: $aReason"
1238 fconfigure $aFile -translation binary
1239 puts -nonewline $aFile [join $theData $anUsedEol]
1242 loginfo "File $theFilePath modified"
1245 # collect all subdirs of theBaseDir
1246 proc CollectDirStructure {theBaseDir} {
1247 set aDirs [glob -nocomplain -directory $theBaseDir -type d *]
1250 foreach aDir $aDirs {
1251 foreach aSubDir [CollectDirStructure $aDir] {
1252 lappend aSubDirs $aSubDir
1256 foreach aSubDir $aSubDirs {
1257 lappend aDirs $aSubDir
1263 # check existence of theFileName file in several folders (theIncPaths)
1264 proc SearchForFile {theIncPaths theFileName} {
1265 foreach aPath $theIncPaths {
1266 if {[file exists "${aPath}/${theFileName}"]} {
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
1277 proc _check_line { line } {
1278 upvar _isMulti _isMulti
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
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]} {
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}]
1309 if {[lindex $mc_e 0] < [lindex $mc_b 0]} {
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}]"]
1323 set _cmnt $_cmnt$line
1330 # Create Tk-based logger which allows convenient consulting the upgrade process.
1331 proc _create_logger {} {
1332 if { [catch {winfo exists .h}] } {
1333 logerr "Error: Tk commands are not available, cannot create UI!"
1337 if { ![winfo exists .h ] } {
1339 wm title .h "Conversion log"
1340 wm geometry .h +320+200
1343 text .h.t -yscrollcommand {.h.sbar set}
1344 scrollbar .h.sbar -orient vertical -command {.h.t yview}
1346 pack .h.sbar -side right -fill y
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.
1356 proc _logcommon {theLogMessage {theMessageColor ""}} {
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] \
1368 puts $aLogFile $aTimeAndMessage
1371 logerr "Error: cannot open $LogFilePath log file due to $aReason"
1375 if { ! [catch {winfo exists .h} res] && $res } {
1376 .h.t insert end "$theLogMessage\n"
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]
1382 .h.t tag add my_tag_$aLineNb end-2l end-1l
1383 .h.t tag configure my_tag_$aLineNb -background $theMessageColor
1392 # Puts information message to logger.
1397 # Puts warning message to logger.
1399 _logcommon $a "pink"
1402 # Puts error message to logger.