Posted to tcl by bairui at Fri Nov 02 04:47:04 GMT 2018view raw

  1. proc parseScript {script} {
  2. global knownGlobals unknownCommands knownCommands syntax
  3.  
  4. catch {unset unknownCommands}
  5. set unknownCommands {}
  6. set knownVars {}
  7. array set ::knownAliases {}
  8. array set ::namespacePaths {}
  9. foreach g $knownGlobals {
  10. knownVar knownVars $g
  11. dict set knownVars $g set 1
  12. }
  13. set ::Nagelfar(firstpass) 0
  14. set script [buildLineDb $script]
  15. set ::instrumenting(script) $script
  16.  
  17. pushNamespace {}
  18. if {$::Nagelfar(2pass)} {
  19. # First do one round with proc checking
  20. set ::Nagelfar(firstpass) 1
  21. parseBody $script 0 knownVars
  22. #echo "Second pass"
  23. set ::Nagelfar(firstpass) 0
  24. }
  25. parseBody $script 0 knownVars
  26. popNamespace
  27.  
  28. # Check commands that where unknown when encountered
  29. # FIXA: aliases
  30. foreach apa $unknownCommands {
  31. foreach {cmd cmds index} $apa break
  32. set found 0
  33. foreach cmdCandidate $cmds {
  34. if {[info exists syntax($cmdCandidate)] || \
  35. [lsearch $knownCommands $cmdCandidate] >= 0} {
  36. set found 1
  37. break
  38. }
  39. }
  40. if {!$found} {
  41. # Close brace is reported elsewhere
  42. if {$cmd ne "\}"} {
  43. # Different messages depending on name
  44. if {[regexp {^(?:(?:[\w',:.-]+)|(?:%W))$} $cmd]} {
  45. errorMsg W "Unknown command \"$cmd\"" $index
  46. } else {
  47. errorMsg E "Strange command \"$cmd\"" $index
  48. }
  49. }
  50. }
  51. }
  52. # Update known globals.
  53. foreach var [dict keys $knownVars] {
  54. if {[dict get $knownVars $var namespace] != ""} continue
  55. if {[dict get $knownVars $var local]} continue
  56. # Check if it has been set.
  57. if {[dict get $knownVars $var set]} {
  58. if {[lsearch $knownGlobals $var] == -1} {
  59. lappend knownGlobals $var
  60. }
  61. }
  62. }
  63. }
  64.