0030686: Visualization, SelectMgr_ViewerSelector - sorting issues of transformation...
[occt.git] / 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 }