Posted to tcl by mjanssen at Thu Oct 08 16:56:42 GMT 2020view raw

  1. proc tokenize {script} {
  2. #puts [lindex [info level 0] 0]
  3. set ctxt(rest) [split $script {}]
  4. set ctxt(parsed) {}
  5. set ctxt(currentCmd) {}
  6. while {$ctxt(rest) ne {}} {
  7. tokenizeCommentOrCommand ctxt
  8. }
  9. return $ctxt(parsed)
  10. }
  11. proc handleContinuation {ctxtVar} {
  12. upvar $ctxtVar ctxt
  13. lassign $ctxt(rest) char next
  14. if {$char eq "\\" && $next eq "\n"} {
  15. # puts [lindex [info level 0] 0]
  16. set ctxt(rest) [lrange $ctxt(rest) 1 end]
  17. dropSpace ctxt
  18. set ctxt(rest) [linsert $ctxt(rest) 0 " "]
  19. }
  20. }
  21. proc dropSpace {ctxtVar} {
  22. #puts [lindex [info level 0] 0]
  23. upvar $ctxtVar ctxt
  24. while {1} {
  25. set new [lassign $ctxt(rest) char]
  26. if {[string is space $char] && $char ne {}} {
  27. set ctxt(rest) $new
  28. continue
  29. }
  30. break
  31. }
  32. }
  33. proc tokenizeCommentOrCommand {ctxtVar} {
  34. #puts [lindex [info level 0] 0]
  35. upvar $ctxtVar ctxt
  36. # parray ctxt
  37. while {1} {
  38. dropSpace ctxt
  39. handleContinuation ctxt
  40. lassign $ctxt(rest) char
  41. if {$char eq "#"} {
  42. tokenizeComment ctxt
  43. } else {
  44. tokenizeCommand ctxt
  45. }
  46. return
  47. }
  48. }
  49. proc tokenizeComment {ctxtVar} {
  50. #puts [lindex [info level 0] 0]
  51. upvar $ctxtVar ctxt
  52. set comment {}
  53. while {1} {
  54. handleContinuation ctxt
  55. set ctxt(rest) [lassign $ctxt(rest) char]
  56. if {$char eq "\n" || $char eq {}} {
  57. lappend ctxt(parsed) [list "#" $comment]
  58. return
  59. }
  60. append comment $char
  61. }
  62. }
  63. proc tokenizeWord {ctxtVar} {
  64. #puts [lindex [info level 0] 0]
  65. upvar $ctxtVar ctxt
  66. set word {}
  67. dropSpace ctxt
  68. # expand ?
  69. if {[join [lrange $ctxt(rest) 0 3] {}] eq "{*}" && ![string is space [lindex $ctxt(rest) 4]]} {
  70. append word "{*}"
  71. set ctxt(rest) [lrange $ctxt(rest) 0 3]
  72. }
  73. if {[string is space [lindex $ctxt(rest) 0 ]]} {
  74. error "Unexpected space at start of word"
  75. }
  76. set ctxt(rest) [lassign $ctxt(rest) char]
  77. append word $char
  78. switch -exact $char {
  79. "\{" {append word [tokenizeBraceWord ctxt]}
  80. "\"" {append word [tokenizeQuoteWord ctxt]}
  81. "\[" {append word [tokenizeSubstWord ctxt]}
  82. default {append word [tokenizeBareWord ctxt]}
  83. }
  84. lappend ctxt(currentCmd) $word
  85. }
  86. proc tokenizeCommand {ctxtVar} {
  87. #puts [lindex [info level 0] 0]
  88. upvar $ctxtVar ctxt
  89. # parray ctxt
  90. set ctxt(currentCmd) {}
  91. set word {}
  92. while {1} {
  93. set new [lassign $ctxt(rest) char]
  94. if {$char eq "\n" || $char eq {}} {
  95. if {[llength $ctxt(currentCmd)] > 0} {
  96. lappend ctxt(parsed) [list cmd {*}$ctxt(currentCmd)]
  97. }
  98. set ctxt(rest) $new
  99. return
  100. }
  101. dropSpace ctxt
  102. handleContinuation ctxt
  103. tokenizeWord ctxt
  104. }
  105. }
  106. proc tokenizeQuoteWord {ctxtVar} {
  107. #puts [lindex [info level 0] 0]
  108. upvar $ctxtVar ctxt
  109. set word {}
  110. while {1} {
  111. handleContinuation ctxt
  112. set ctxt(rest) [lassign $ctxt(rest) char]
  113. append word $char
  114. if {$char eq "\\"} {
  115. set ctxt(rest) [lassign $ctxt(rest) char]
  116. append word $char
  117. continue
  118. }
  119. if {$char eq "\""} {
  120. break
  121. }
  122. }
  123. return $word
  124. }
  125. proc tokenizeBraceWord {ctxtVar} {
  126. #puts [lindex [info level 0] 0]
  127. upvar $ctxtVar ctxt
  128. set word {}
  129. while {1} {
  130. handleContinuation ctxt
  131. set ctxt(rest) [lassign $ctxt(rest) char]
  132. append word $char
  133. if {$char eq "\\"} {
  134. set ctxt(rest) [lassign $ctxt(rest) char]
  135. append word $char
  136. continue
  137. }
  138. if {$char eq "\{"} {
  139. append word [tokenizeBraceWord ctxt]
  140. continue
  141. }
  142. if {$char eq "\}"} {
  143. break
  144. }
  145. }
  146. return $word
  147. }
  148. proc tokenizeSubstWord {ctxtVar} {
  149. #puts [lindex [info level 0] 0]
  150. upvar $ctxtVar ctxt
  151. set word {}
  152. while {1} {
  153. handleContinuation ctxt
  154. set ctxt(rest) [lassign $ctxt(rest) char]
  155. append word $char
  156. if {$char eq "\\"} {
  157. set ctxt(rest) [lassign $ctxt(rest) char]
  158. append word $char
  159. continue
  160. }
  161. if {$char eq "\["} {
  162. append word [tokenizeSubstWord ctxt]
  163. continue
  164. }
  165. if {$char eq "\]"} {
  166. break
  167. }
  168. }
  169. return $word
  170. }
  171. proc tokenizeBareWord {ctxtVar} {
  172. #puts [lindex [info level 0] 0]
  173. upvar $ctxtVar ctxt
  174. set word {}
  175. while {1} {
  176. handleContinuation ctxt
  177. set ctxt(rest) [lassign $ctxt(rest) char]
  178. append word $char
  179. if {$char eq "\\"} {
  180. set ctxt(rest) [lassign $ctxt(rest) char]
  181. append word $char
  182. continue
  183. }
  184. if {$char eq "\["} {
  185. append word [tokenizeSubstWord ctxt]
  186. continue
  187. }
  188. if {[string is space $char]} {
  189. break
  190. }
  191. }
  192. return [string trimright $word]
  193. }

AltStyle によって変換されたページ (->オリジナル) /