Posted to tcl by mjanssen at Thu Oct 08 12:47:12 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. lset ctxt(rest) 1 " "
  17. set ctxt(rest) [lrange $ctxt(rest) 1 end]
  18. dropSpace ctxt
  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. # expand ?
  68. if {[join [lrange $ctxt(rest) 0 3] {}] eq "{*}" && ![string is space [lindex $ctxt(rest) 4]]} {
  69. append word "{*}"
  70. set ctxt(rest) [lrange $ctxt(rest) 0 3]
  71. }
  72. if {[string is space [lindex $ctxt(rest) 0 ]]} {
  73. error "Unexpected space at start of word"
  74. }
  75. set ctxt(rest) [lassign $ctxt(rest) char]
  76. append word $char
  77. switch -exact $char {
  78. "\{" {append word [tokenizeBraceWord ctxt]}
  79. "\"" {append word [tokenizeQuoteWord ctxt]}
  80. "\[" {append word [tokenizeSubstWord ctxt]}
  81. default {append word [tokenizeBareWord ctxt]}
  82. }
  83. lappend ctxt(currentCmd) $word
  84. }
  85. proc tokenizeCommand {ctxtVar} {
  86. #puts [lindex [info level 0] 0]
  87. upvar $ctxtVar ctxt
  88. # parray ctxt
  89. set ctxt(currentCmd) {}
  90. set word {}
  91. while {1} {
  92. set new [lassign $ctxt(rest) char]
  93. if {$char eq "\n" || $char eq {}} {
  94. if {[llength $ctxt(currentCmd)] > 0} {
  95. lappend ctxt(parsed) [list cmd {*}$ctxt(currentCmd)]
  96. }
  97. set ctxt(rest) $new
  98. return
  99. }
  100. dropSpace ctxt
  101. handleContinuation ctxt
  102. tokenizeWord ctxt
  103. }
  104. }
  105. proc tokenizeQuoteWord {ctxtVar} {
  106. #puts [lindex [info level 0] 0]
  107. upvar $ctxtVar ctxt
  108. set word {}
  109. while {1} {
  110. handleContinuation ctxt
  111. set ctxt(rest) [lassign $ctxt(rest) char]
  112. append word $char
  113. if {$char eq "\\"} {
  114. set ctxt(rest) [lassign $ctxt(rest) char]
  115. append word $char
  116. continue
  117. }
  118. if {$char eq "\""} {
  119. break
  120. }
  121. }
  122. return $word
  123. }
  124. proc tokenizeBraceWord {ctxtVar} {
  125. #puts [lindex [info level 0] 0]
  126. upvar $ctxtVar ctxt
  127. set word {}
  128. while {1} {
  129. handleContinuation ctxt
  130. set ctxt(rest) [lassign $ctxt(rest) char]
  131. append word $char
  132. if {$char eq "\\"} {
  133. set ctxt(rest) [lassign $ctxt(rest) char]
  134. append word $char
  135. continue
  136. }
  137. if {$char eq "\{"} {
  138. append word [tokenizeBraceWord ctxt]
  139. continue
  140. }
  141. if {$char eq "\}"} {
  142. break
  143. }
  144. }
  145. return $word
  146. }
  147. proc tokenizeSubstWord {ctxtVar} {
  148. #puts [lindex [info level 0] 0]
  149. upvar $ctxtVar ctxt
  150. set word {}
  151. while {1} {
  152. handleContinuation ctxt
  153. set ctxt(rest) [lassign $ctxt(rest) char]
  154. append word $char
  155. if {$char eq "\\"} {
  156. set ctxt(rest) [lassign $ctxt(rest) char]
  157. append word $char
  158. continue
  159. }
  160. if {$char eq "\["} {
  161. append word [tokenizeSubstWord ctxt]
  162. continue
  163. }
  164. if {$char eq "\]"} {
  165. break
  166. }
  167. }
  168. return $word
  169. }
  170. proc tokenizeBareWord {ctxtVar} {
  171. #puts [lindex [info level 0] 0]
  172. upvar $ctxtVar ctxt
  173. set word {}
  174. while {1} {
  175. handleContinuation ctxt
  176. set ctxt(rest) [lassign $ctxt(rest) char]
  177. append word $char
  178. if {$char eq "\\"} {
  179. set ctxt(rest) [lassign $ctxt(rest) char]
  180. append word $char
  181. continue
  182. }
  183. if {$char eq "\["} {
  184. append word [tokenizeSubstWord ctxt]
  185. continue
  186. }
  187. if {[string is space $char]} {
  188. break
  189. }
  190. }
  191. return [string trimright $word]
  192. }

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