adm/upgrade.tcl

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