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