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